Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re^4: Problem in row deletion with Tk::Table

by emilbarton (Scribe)
on Aug 30, 2013 at 08:40 UTC ( [id://1051572]=note: print w/replies, xml ) Need Help??


in reply to Re^3: Problem in row deletion with Tk::Table
in thread Problem in row deletion with Tk::Table

Here's your standalone:
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=>\&section_add )->form( -top=>[$section_label ,4] ,-right=>['%99',4] ); my $del_section_bw = $Struct_frame2->Button( -text=>'Delete' ,-command=>\&section_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] ); &section_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; &section_header; foreach (@rows) { &section_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;

Replies are listed 'Best First'.
Re^5: Problem in row deletion with Tk::Table
by choroba (Cardinal) on Aug 30, 2013 at 09:15 UTC
    You seem to not define the number of rows for the table, so it defaults to 10. If you call clear, only the first 10 lines are deleted. Add
    -rows => 100

    to the table constructor parameters and everything works.

    BTW, you can chomp @vals and push @rows, \@vals.

    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
      Thanks for the tips, but regarding the table your solution doesn't help. It behaves exactly the same whether I set rows => 100 or not. Anyway I was only testing within the first 10 rows.
        It works for me. Try upgrading Tk.
        لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re^5: Problem in row deletion with Tk::Table ( clear off-by-one)
by Anonymous Monk on Aug 30, 2013 at 10:34 UTC

    :) Ignoring all the issues with your code with short-circuit

    sub section_del { return $Section_tblw->clear;
    looks like Tk::Table is not deleting checkboxes

    so I replace that with  return my_clear( $Section_tblw ); and one or three dd-Dumper-ings later, its an off-by-one error in clear

    sub my_clear { my $self = shift; my $rows = $self->cget( -rows ); my $cols = $self->cget( -columns ); ## 1st row is labels foreach my $r ( 1 .. $rows ) { #~ foreach my $c ( 1 .. $cols ) { ## 1st column is 1st column foreach my $c ( 0 .. $cols ) { my $old = $self->get( $r, $c ); next unless $old; $self->LostSlave( $old ); $old->destroy; } } $self->_init; $self->QueueLayout( Tk::Table::_SlaveSize() ); } ## end sub my_clear

    I imagine the OBO error migt stem because at one point the first column in each row might have been a counter (nth row) ...

      Great, this is it! I'll try updating Tk::Table too. Many thanks!
      hmm, considering chorobas comment, maybe the row/col start indexes in clear ought to consider -fixedrows / -fixedcolumns

      but, I really don't know my way around Tk::Table :) so I've no idea what it/clear should actually do

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1051572]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2024-03-19 03:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found