Skip Menu |

This queue is for tickets about the Tk CPAN distribution.

Report information
The Basics
Id: 77078
Status: open
Priority: 0/
Queue: Tk

People
Owner: SREZIC [...] cpan.org
Requestors: DJIBEL [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in: 804.030
Fixed in: (no value)



Subject: Tk::Spinbox , -invalidcommand not working
Dear, -invalidcommand option not seem to be work. run this script to see. Return 0 have not effect too use -invalidcommand. Best Regards, N.B. Perl 5.14 (ActivePerl) on Windows XP, Debian (perl 5.10). #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(-title => "spinbox"); my $spinbox1 = $mw->Spinbox( -width => 20, -value => [1 .. 10], -validate => 'all', -vcmd => \&validate, -invalidcommand => \&invalidate, )->pack; sub validate { my ($proposed_value, undef, $current_value) = @_; if ( $proposed_value == 3 ) { return 0; } print "$current_value and $proposed_value\n"; return 1; } sub invalidation { my ($proposed_value, undef, $current_value) = @_; print "invalid : $proposed_value\n"; $mw->bell; } MainLoop();
On 2012-05-09 08:40:26, DJIBEL wrote: Show quoted text
> Dear, > > -invalidcommand option not seem to be work. > run this script to see. > > Return 0 have not effect too use -invalidcommand. > > Best Regards, > > N.B. Perl 5.14 (ActivePerl) on Windows XP, Debian (perl 5.10). > > #!/usr/bin/perl > use warnings; > use strict; > use Tk; > > my $mw = MainWindow->new(-title => "spinbox"); > my $spinbox1 = $mw->Spinbox( > -width => 20, > -value => [1 .. 10], > -validate => 'all', > -vcmd => \&validate, > -invalidcommand => \&invalidate, > )->pack; > > sub validate { > my ($proposed_value, undef, $current_value) = @_; > if ( $proposed_value == 3 ) { return 0; } > > print "$current_value and $proposed_value\n"; > return 1; > } > > sub invalidation { > my ($proposed_value, undef, $current_value) = @_; > print "invalid : $proposed_value\n"; > $mw->bell; > } > > MainLoop();
I see a problem in your script: -invalidcommand calls invalidate, but the sub is actually called invalidation. Regards, Slaven
Le Ven 17 Mai 2013 17:31:39, SREZIC a écrit : Show quoted text
> On 2012-05-09 08:40:26, DJIBEL wrote:
> > Dear, > > > > -invalidcommand option not seem to be work. > > run this script to see. > > > > Return 0 have not effect too use -invalidcommand. > > > > Best Regards, > > > > N.B. Perl 5.14 (ActivePerl) on Windows XP, Debian (perl 5.10). > > > > #!/usr/bin/perl > > use warnings; > > use strict; > > use Tk; > > > > my $mw = MainWindow->new(-title => "spinbox"); > > my $spinbox1 = $mw->Spinbox( > > -width => 20, > > -value => [1 .. 10], > > -validate => 'all', > > -vcmd => \&validate, > > -invalidcommand => \&invalidate, > > )->pack; > > > > sub validate { > > my ($proposed_value, undef, $current_value) = @_; > > if ( $proposed_value == 3 ) { return 0; } > > > > print "$current_value and $proposed_value\n"; > > return 1; > > } > > > > sub invalidation { > > my ($proposed_value, undef, $current_value) = @_; > > print "invalid : $proposed_value\n"; > > $mw->bell; > > } > > > > MainLoop();
> > I see a problem in your script: -invalidcommand calls invalidate, but > the sub is actually called invalidation. > > Regards, > Slaven
Dear Slaven, Test this script : #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(-title => "spinbox"); my $spinbox1 = $mw->Spinbox( -width => 20, -value => [1 .. 10], -validate => 'all', -vcmd => \&validate, -invalidcommand => \&invalidation, )->pack; sub validate { my ($proposed_value, undef, $current_value) = @_; if ( $proposed_value == 3 ) { print "Sub : validate -> $proposed_value\n"; $mw->bell; return 0; } print "$current_value and $proposed_value\n"; return 1; } sub invalidation { my ($proposed_value, undef, $current_value) = @_; print "Sub : invalidation -> $proposed_value and $current_value\n"; $mw->bell; } MainLoop(); The invalidation sub is never called. If you use spinbox from 1 to 10, at 3, the invalidation sub is not called, just validate sub. And after that, from 4 to 10 any sub didn't called. Best Regards, Djibel
On 2013-05-18 05:43:07, DJIBEL wrote: [..] Show quoted text
> > The invalidation sub is never called. > If you use spinbox from 1 to 10, at 3, the invalidation sub is not > called, just validate sub. And after that, from 4 to 10 any sub didn't > called.
Hello Djibel, my analysis look like following: validation seems to work if numbers are entered directly in the entry part of the spinbox. So if I enter "3" into the entry, I see the "Sub : invalidation ..." string printed, and validation of further numbers still works. It just does not work if the arrow buttons of the spinbox are used. Once the invalidcmd is hit, validation is completely turned off. A similar Tcl/Tk script (see attachment) behaves the same. Looking at the C code, the problem seems to happen in EntryValidateChang in tkEntry.c. There's a comment telling: /* * If we were doing forced validation (like via a variable trace) and * the command returned 0, the we turn off validation because we * assume that textvariables have precedence in managing the value. * We also don't call the invcmd, as it may want to do entry * manipulation which the setting of the var will later wipe anyway. */ It seems that this "turn off validation" unfortunately also happens for selecting the up/down arrows. I can just propose a workaround: define the -command option to explicitely do the validation, e.g. like this: -command => sub { $spinbox1->validate }, This way the invalidecmd seems also to be called when selecting the up/down arrows. Let me know if this workaround works for you. Regards, Slaven
Subject: invtk.tcl
proc val {a} { if {$a == 3} { return 0 } puts "val: $a" return 1 } proc invalidation {a} { puts "inv: $a" return 0 } spinbox .s -value "1 2 3 4 5" -width 20 -validate all -vcmd {val %P} -invalidcommand {invalidation %P} pack .s
Le Sam 16 Nov 2013 10:02:10, SREZIC a écrit : Show quoted text
> On 2013-05-18 05:43:07, DJIBEL wrote: > > [..] >
> > > > The invalidation sub is never called. > > If you use spinbox from 1 to 10, at 3, the invalidation sub is not > > called, just validate sub. And after that, from 4 to 10 any sub > > didn't > > called.
> > Hello Djibel, > > my analysis look like following: validation seems to work if numbers > are entered directly in the entry part of the spinbox. So if I enter > "3" into the entry, I see the "Sub : invalidation ..." string printed, > and validation of further numbers still works. It just does not work > if the arrow buttons of the spinbox are used. Once the invalidcmd is > hit, validation is completely turned off. > > A similar Tcl/Tk script (see attachment) behaves the same. > > Looking at the C code, the problem seems to happen in > EntryValidateChang in tkEntry.c. There's a comment telling: > > /* > * If we were doing forced validation (like via a variable trace) and > * the command returned 0, the we turn off validation because we > * assume that textvariables have precedence in managing the value. > * We also don't call the invcmd, as it may want to do entry > * manipulation which the setting of the var will later wipe anyway. > */ > > It seems that this "turn off validation" unfortunately also happens > for selecting the up/down arrows. > > I can just propose a workaround: define the -command option to > explicitely do the validation, e.g. like this: > > -command => sub { $spinbox1->validate }, > > This way the invalidecmd seems also to be called when selecting the > up/down arrows. > > Let me know if this workaround works for you. > > Regards, > Slaven
Dear Slaven, Using this program seem to be ok #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new( -title => "spinbox" ); my $spinbox1 = $mw->Spinbox( -width => 20, -value => [ 1 .. 10 ], -validate => 'all', -vcmd => \&validate, -invalidcommand => \&invalidation, )->pack; $spinbox1->configure( -command => sub { $spinbox1->validate } ); sub validate { my ( $proposed_value, undef, $current_value ) = @_; if ( $proposed_value == 3 ) { print "Sub : validate -> $proposed_value\n"; $mw->bell; return 0; } print "$current_value and $proposed_value\n"; return 1; } sub invalidation { my ( $proposed_value, undef, $current_value ) = @_; print "Sub : invalidation -> $proposed_value and $current_value\n"; $mw->bell; } MainLoop(); I have add your suggestion : $spinbox1->configure( -command => sub { $spinbox1->validate } ); I don't know how you can patch Tk module. Best Regards