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;

[download]

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

    [download]

    to the table constructor parameters and everything works.

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

    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
[reply]
[d/l]
[select]
      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.
[reply]
        It works for me. Try upgrading Tk.
        لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
[reply]
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;

    [download]
    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

    [download]

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

[reply]
[d/l]
[select]
      Great, this is it! I'll try updating Tk::Table too. Many thanks!
[reply]
      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

[reply]

In Section Seekers of Perl Wisdom