UPDATE: using choroba's solution in Table constructor, doesn't change the issue.
#!/usr/bin/perl -s
use Modern::Perl;
use strict;
use warnings;
use Tk;
require Tk::NoteBook;
require Tk::Table;
my $Project = {};
my %Tabs;
## ### MAIN WINDOW:
my $mw = MainWindow->new;
$mw->minsize(qw(640 480));
$mw->geometry('800x600');
$mw->bisque;
$mw->configure();
my $Statusbar = $mw->Label(
-textvariable=>$Project->{'status'}
,-background => 'lightgrey'
)->pack(
-side=>'bottom'
,-anchor =>'sw'
,-expand => 'no'
);
## ### NOTEBOOK WIDGET:
my $Book = $mw->NoteBook(
-backpagecolor => 'lightgrey'
,-focuscolor => 'pink'
,-inactivebackground => 'lightgrey'
)->pack(
-fill=>'both'
,-side=>'top'
,-expand=>1
);
$Tabs{'structure'} = $Book->add(
"Structure",
-label=>"Structure",
-state=>'normal'
);
my $Struct_frame2 = $Tabs{'structure'}->Frame(
-borderwidth=>4,
-relief=>'groove'
);
$Struct_frame2->form(
-top=>['%1',0],
-left=>['%1',0],
-right=>['%99',0],
-bottom=>['%60',4]
);
## ### TABLE WIDGET:
my $Section_tblw = $Struct_frame2->Table(
-columns => 12
,-rows => 100
,-relief=>'raised'
,-scrollbars => 'e'
,-fixedrows => 1
,-fixedcolumns => 0
,-takefocus => 'on'
);
## ### SECTIONS BUTTONS:
my $section_label = $Struct_frame2->Label( -text=>'Sections:' )->form(
-top=>['%1',6]
,-right=>['%99',4]
);
my $add_section_bw = $Struct_frame2->Button(
-text=>'Add'
,-command=>\§ion_add
)->form(
-top=>[$section_label ,4]
,-right=>['%99',4]
);
my $del_section_bw = $Struct_frame2->Button(
-text=>'Delete'
,-command=>\§ion_del
)->form(
-top=>[$add_section_bw,4]
,-right=>['%99',4]
);
$Section_tblw->form(
-top=>['%1',4],
-left=>['%1',4],
-right=>['%90',4],
-bottom=>['%99',4]
);
§ion_header(); ## Create the header row.
$mw->title('Perl Test: ');
## ### MAIN LOOP:
MainLoop;
## ### SUBROUTINES:
## ### section_add() : adds a new row
sub section_add {
my @vals = @_;
my $len = $Section_tblw->totalRows;
my $pref = "Tksection_".$len;
die ("Not a valid table ($len).") if ($len < 1);
die ("Too many sections ($len).") if ($len > 100);
my $tmp;
## 0 Sel btn:
$Project->{$pref.'_sel'} =
defined($vals[0])? $vals[0] : 0 ;
$Section_tblw->put(
$len, 0, $Section_tblw->Checkbutton(
-variable =>\$Project->{$pref.'_sel'}
,-relief =>'ridge'
,-onvalue=>1
,-offvalue=>0
,-state =>'normal'
,-foreground =>'lightgrey'
,-background =>'lightgrey'
,-disabledforeground=>'lightgrey'
)
);
## 1 set id:
$Project->{$pref.'_sets'} =
defined($vals[1])? $vals[1] : "";
## The set id is attributed manually.
$Section_tblw->put($len, 1, $Section_tblw->Entry(
-background =>'lightgrey'
,-foreground =>'lightgrey'
,-width=>24
,-textvariable=>\$Project->{$pref.'_sets'}
)
);
## 2 tempo.
$Project->{$pref.'_tempo'} =
defined($vals[2])? $vals[2] : "t 0 60";
$Section_tblw->put($len, 2, $Section_tblw->Entry(
-background =>'lightgrey'
,-foreground =>'lightgrey'
,-width=>12
,-textvariable=>\$Project->{$pref.'_tempo'}
)
);
## 3 comments.
$Project->{$pref.'_comment'} =
defined($vals[3])? $vals[3] : "" ;
$Section_tblw->put($len, 3, $Section_tblw->Entry(
-background =>'lightgrey'
,-foreground =>'lightgrey'
,-width=>18
,-textvariable=>\$Project->{$pref.'_comment'}
)
);
return 1;
} ## END section_add().
## ### section_del() : deletes rows
sub section_del {
my $pref = 0;
my $row = 0;
my (@rows,$rows);
for (my $i = 1; $i < 100; $i++){
$pref = "Tksection_$i";
$rows .= "$i," if(
exists $Project->{$pref.'_sel'} &&
$Project->{$pref.'_sel'} == 1
);
}
$rows =~s/^(.*)(,)$/$1/;
require Tk::Dialog;
my $d = $mw->Dialog(
-title => "Alert",
-text => "Really delete sections ($rows) ?",
-buttons => ["Delete", "Cancel"]
);
if ($d->Show !~ /Delete/) {
goto SEC_DEL_END;
}
$Section_tblw->see(0,0);
for (my $i = 1; $i < 100; $i++){
$pref = "Tksection_$i";
next unless (exists $Project->{$pref.'_sel'});
if ($Project->{$pref.'_sel'} == 1) {
## Don't copy selected rows.
delete $Project->{$pref.'_sel'};
delete $Project->{$pref.'_sets'};
delete $Project->{$pref.'_tempo'};
delete $Project->{$pref.'_comment'};
next;
}
my @vals;
$vals[0] = delete $Project->{$pref.'_sel'};
$vals[1] = delete $Project->{$pref.'_sets'};
$vals[2] = delete $Project->{$pref.'_tempo'};
$vals[3] = delete $Project->{$pref.'_comment'};
for (my $i = 0; $i < scalar(@vals); $i++) {
chomp $vals[$i]
}
push @rows, [@vals];
} ## END for i.
$Section_tblw->clear;
§ion_header;
foreach (@rows) {
§ion_add(@$_)
}
SEC_DEL_END:
return 1;
} ## END section_del().
## ### section_header() : creates headers
sub section_header {
my $tmp_label;
$tmp_label = $Section_tblw->Label(
-text =>"sel",
-relief =>'groove',
-justify => 'center'
);
$Section_tblw->put(0, 0, $tmp_label);
$tmp_label = $Section_tblw->Label(
-text =>"sets in section",
-relief =>'groove',
-justify => 'center'
);
$Section_tblw->put(0, 1, $tmp_label);
$tmp_label = $Section_tblw->Label(
-text =>"tempo",
-relief =>'groove',
-justify => 'center'
);
$Section_tblw->put(0, 2, $tmp_label);
$tmp_label = $Section_tblw->Label(
-text =>"comment",
-relief =>'groove',
-justify => 'center'
);
$Section_tblw->put(0, 3, $tmp_label);
return 1;
} ## END section_header().
1;