Figured it out, mostly.
This disables the arrow key bindings so they don't change the active cell but it also
disables using the arrow keys to navigate text strings within a cell. Is it possible
to turn off cell navigation but still be able to navigate within a cell.
See code below.
use Tk;
use Tk::TableMatrix;
use strict;
my @swap_bindtags;
my @swapped_bindtags;
my @color = qw/green red/;
my $MainWindowMain=tkinit;
my $TableMatrix = $MainWindowMain->Scrolled('TableMatrix')->pack;
my $subwidget = $TableMatrix->Subwidget('scrolled');
for (qw/Up Down Left Right/) {
$TableMatrix->bind("<$_>",[\&mybinding,Ev('K')]);
}
my $Button = $MainWindowMain->Button(-text=>'Class Binding Off')->pack;
my $Button1 = $MainWindowMain->Button(-text=>'Class Binding On')->pack;
$Button->configure(-command=>[\&togglebind,$Button]);
$Button1->configure(-command=>[\&togglebind,$Button1]);
MainLoop;
sub togglebind {
@swap_bindtags = $subwidget->bindtags;
foreach (@swap_bindtags) {
chomp;
print "Bind Tag: $_\n";
}
print "\n" . $_[0]->cget('-text') . "\n";
if ($_[0]->cget('-text') =~ /off$/i) {
print "==== OFF =====\n";
$subwidget->bindtags( [
$subwidget,ref($subwidget),$subwidget->toplevel,'all' ] );
}
else {
print "==== ON =====\n";
$subwidget->bindtags( [
ref($subwidget),$subwidget,$subwidget->toplevel,'all' ] );
}
@swapped_bindtags = $subwidget->bindtags;
foreach (@swapped_bindtags) {
chomp;
print "Swapped Bind Tag: $_\n";
}
print "\n";
}
sub mybinding {
printf("You pressed %s at:\t%s\n", $_[1],scalar gmtime);
$_[0]->break;
}
Thanks for the help.
Dax
*********** REPLY SEPARATOR ***********
On 10/6/2003 at 8:47 AM Dax T. Games wrote:
>Excellent Info but heres another wrinkle. I am using the 'Scrolled'
>method with TableMatrix.
>
>If you change:
>
>my $tm = $mw->TableMatrix->pack;
>
>To:
>
>my $tm = $mw->Scrolled('TableMatrix')->pack;
>
>in the code below.
>
>The new code below executes without error but does not change the bindings
>as before.
>
>Any other ideas.
>
>Dax
>
>*********** REPLY SEPARATOR ***********
>
>On 10/5/2003 at 1:36 PM Jack wrote:
>
>>----- Original Message -----
>>From: "Dax T. Games" <[EMAIL PROTECTED]>
>>To: <[EMAIL PROTECTED]>
>>Sent: Saturday, October 04, 2003 3:36 PM
>>Subject: Overiding default bindings in PerlTk
>>
>>
>>> Anyone know how to overide default bindings in a PerlTk module without
>>editing
>>the *.pm file that defines the bindings.
>>>
>>> I am working with Tk::TableMatrix and have a need to temporarily disable
>>the
>>arrow key bindings so that the arrow keys have no effect. I will then
>>need to
>>re-enable the arow key bindings so I don't want to remove them from the
>>module.
>>>
>>> Below is how the bindings are created in the module:
>>> $mw->bind($class,'<Up>',['MoveCell',-1,0]);
>>> $mw->bind($class,'<Down>',['MoveCell',1,0]);
>>> $mw->bind($class,'<Left>',['MoveCell',0,-1]);
>>> $mw->bind($class,'<Right>',['MoveCell',0,1]);
>>>
>>
>>There is a nice trick you can use instead of sub-classing or removing
>>bindings.
>>A bit of an explanation follows the solution below.
>>########################
>>use Tk;
>>use Tk::TableMatrix;
>>use strict;
>>
>>my @swap_bindtags;
>>my @color = qw/green red/;
>>
>>my $mw=tkinit;
>>my $tm = $mw->TableMatrix->pack;
>>
>>for (qw/Up Down Left Right/){
>> $tm->bind("<$_>",[\&mybinding,Ev('K')]);
>>}
>>
>>my $b = $mw->Button(
>>-text=>'Toggle Binding',
>>-bg=>$color[0])->pack;
>>
>>$b->configure(-command=>[\&togglebind,$b]);
>>
>>MainLoop;
>>
>>sub togglebind
>>{
>> $_[0]->configure(-bg=>$color[1]);
>> @color=reverse(@color);
>> @swap_bindtags = $tm->bindtags;
>> $tm->bindtags( [EMAIL PROTECTED],0,2,3] ] );
>>}
>>
>>sub mybinding
>>{
>> printf("You pressed %s at:\t%s\n", $_[1],scalar gmtime);
>> $_[0]->break;
>>}
>>########################
>>
>>Explanation:
>>If you added your own bindings to a widget (called instance bindings),
>>then BOTH
>>the class binding and instance binding will get triggered. Run the program
>>below
>>and see that the arrow keys to TWO things. It refocusses the current cell
>>on
>>your table, and also runs your binding (which prints out the key you press
>>and
>>the current time). perl/Tk default the order of it's bindings to:
>>
>>1. class
>>2. instance
>>3. Toplevel
>>4. all
>>
>>Now, say that you *only* want your binding to be run (but not the class
>>binding). You can do this by just changing the trigger order of the
>>bindings
>>using the bindtags method. Hence, you trigger your bindings in this order:
>>
>>1. instance
>>2. class
>>3. Toplevel
>>4. all
>>
>>Now, if you don't want the second binding (now the class binding) to be
>>triggered then do a Tk->break within your instance binding subroutine to
>>avoid
>>continuing with the bind sequence.
>>
>>hth....
>>Jack D.
>>Remove '__' from address if replying by e-mail.
>>_______________________________________________
>>Perl-Win32-Users mailing list
>>[EMAIL PROTECTED]
>>To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
>
>
>
>
>_______________________________________________
>Perl-Win32-Users mailing list
>[EMAIL PROTECTED]
>To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
