You can try playing games with "validate" to leave the TableMatrix enabled but only allow change to the one desired cell.
Something like this...
#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11143267
use warnings;
use Tk ':eventtypes';
use Tk::TableMatrix;
use Data::Dumper qw( DumperX);
my $top = MainWindow->new;
my $changing = '';
my $arrayVar = {};
foreach my $row (-1..6){
foreach my $col (-2..5){
$arrayVar->{"$row,$col"} = "r$row, c$col";
}
}
## Test out the use of a callback to define tags on rows and columns
sub rowSub{
my $row = shift;
return "OddRow" if( $row > 0 && $row % 2)
}
sub colSub{
my $col = shift;
return "OddCol" if( $col > 0 && $col%2) ;
}
my $label = $top->Label(-text => "TableMatrix v1 Example");
my $t = $top->Scrolled('TableMatrix', -rows => 8, -cols => 8,
-width => 6, -height => 6,
-titlerows => 1, -titlecols => 2,
-variable => $arrayVar,
-roworigin => -1, -colorigin => -2,
-rowtagcommand => \&rowSub,
-coltagcommand => \&colSub,
-colstretchmode => 'last',
-rowstretchmode => 'last',
-selectmode => 'extended',
-sparsearray => 0,
-validate => 1, # NOT
+E
-validatecommand => \&allowchange, # NOT
+E
);
my $button = $top->Button( -text => "Exit", -command => sub{ $top->des
+troy});
# hideous Color definitions here:
$t->tagConfigure('OddRow', -bg => 'orange', -fg => 'purple');
$t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink');
$t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14);
$label->pack( -expand => 1, -fill => 'both');
$t->pack(-expand => 1, -fill => 'both');
$button->pack(-expand => 1, -fill => 'both');
sub allowchange
{
my ($row, $col) = @_;
my $cell = "$row,$col";
return $cell eq $changing ? 1 : 0;
}
my $cnt;
sub Timer
{
print "Now\n";
my $variable = $t->cget( -var);
$changing = "4,0"; # NOTE
$t->activate("4,0"); # NOTE
$t->curvalue( "Test".$cnt++ ); # NOTE
$changing = ""; # NOTE
#$t->activate("4,0");
#$t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14);
#$t->update();
$top->after(1000, \&Timer);
return 1;
}
$top->after(1000, \&Timer);
Tk::MainLoop;