Last week I posted a query about the way a using the mouse button and key board up, down left and right keys gave different results in the browse command of a tablematrix.I have now heard from John Cerny, the author of the tablematrix, of how to use an afterIdle call to get consistent behavior.I have added this to the Perl code below in case another Monk may want to use the same facilities.
use Tk;
use Tk::TableMatrix;
my $mw = MainWindow->new;
my $arrayVar = {};
my $selcou = 0;
my $last_button_key;
print "Filling Array...\n";
my ($rows,$cols) = (10, 10);
foreach my $row (0..($rows-1)){
foreach my $col (0..($cols-1)){
$arrayVar->{"$row,$col"} = 2*$row + 3*$col;
}
}
print "Creating Table...\n";
my $t = $mw->Scrolled('TableMatrix', -rows => $rows, -cols => $cols,
-width => 10, -height => 10,
-titlerows => 1, -titlecols => 1,
-variable => $arrayVar,
-coltagcommand => \&colSub,
-browsecommand => \&brscmd,
-colstretchmode => 'last',
-rowstretchmode => 'last',
-selectmode => 'extended',
-selecttitles => 0,
-drawmode => 'slow',
-scrollbars=>'se'
);
$t->pack(-expand => 1, -fill => 'both');
sub brscmd_old {
my ($previous_index, $actual_index) = @_;
my ($row, $col) = split ',', $actual_index;
my ($sel, $js, $sel_total);
print "\n[brscmd] entry - last_button_key <$last_button_key>\n";
my $sel = $t->curselection();
$sel_cou += 1;
#$t->curselection($sel_cou)
#&TMRefresh($t);
$sel_total = scalar(@$sel);
print "[brscmd] selection total <$sel_total>\n";
foreach $js (@$sel) {
print "\n[brscmd] actual index <$actual_index> from curselection <
+$js>\n";
}
print "\n[brscmd] exit\n";
}
sub brscmd {
my ( $previous_index, $actual_index ) = @_;
my ( $row, $col ) = split ',', $actual_index;
my ( $sel, $js );
print "\n[brscmd] entry\n";
$t->afterIdle( sub{
my $sel = $t->curselection();
foreach $js (@$sel) {
print "[brscmd] actual index <$actual_index> f
+rom curselection <$js> last_button_key <$last_button_key>\n";
}
}
);
}
#########################################
sub TMRefresh {
#Required input TableMatrix object.
#use to force matrix to update, a code trick
return if (!$_[0]);
$_[0]->configure(-padx =>($_[0]->cget(-padx)));
}
$t->bind('<KeyPress>' =>\&print_keysym);
$t->bind('<ButtonPress-1>' =>\&print_button1);
$t->bind('<ButtonPress-2>' =>\&print_button2);
sub print_keysym{
my($widget) = @_;
my $e = $widget->XEvent;
my($keysym_text, $keysym_decimal) = ($e->K, $e->N);
print "[print_keysym] Keysym = $keysym_text numeric $keysym_decim
+al\n";
$last_button_key = 'key';
}
sub print_button1{
my($widget) = @_;
print "[print_button1] button 1 pressed\n";
$last_button_key = 'button 1';
}
sub print_button2{
my($widget) = @_;
print "[print_button2] button 2 pressed\n";
$last_button_key = 'button 2';
}
Tk::MainLoop;