Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: Entry widget not accepting /

by zentara (Archbishop)
on Oct 05, 2012 at 10:45 UTC ( #997437=note: print w/ replies, xml ) Need Help??


in reply to Entry widget not accepting /

Can you make a minimal test script which demonstrates your / insertion problem? Does it work without the bind to 'Any-Key-Press'. ?


I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh


Comment on Re: Entry widget not accepting /
Re^2: Entry widget not accepting /
by ghosh123 (Monk) on Oct 05, 2012 at 12:22 UTC

    Hi Zentara,
    I could find the problem. The problem is use of File::Spec->canonpath, File::Spec->catdir etc.

    I am attaching my code here, you can just copy/paste them to run.

    The script : anykey.pl

    #!/opt/perl_5.8.8/bin use Tk; use strict; use warnings; use Anykey; my $value; my $mw = MainWindow->new(); $mw->geometry("700x200"); my $frame= $mw->Frame()->grid(-row => 5, -columnspan => 2, -rowspan = +> 2)->pack(-side => 'top', -anchor => 'nw'); my $Entry = $frame->Entry(-width => 80) ->pack(-side => 'left'); my $obj = Anykey->new(widget=>$Entry); $frame->Button(-text => "Browse...",-bg => 'snow3',-command => [\&setd +ir,$obj])->grid()->pack(-side => 'left'); sub setdir { my $obj = shift; $obj->setDir(); } MainLoop;

    The module : Anykey.pm

    package Anykey; use File::Spec; sub new { my ($class,%args) = @_; my $self = { widget => $args{widget}, value=>$args{value}, }; bless $self,$class; my $value = '/home/ghoshabh'; $self->{textvariable} = \$value; $self->{widget}->configure(-textvariable => $self->{textvariable}) +; $self->{widget}->bind('<Any-KeyPress>', sub { $self->onChange() } +); return $self; } sub onChange { my $self = shift; print "onChange is being called: ", ${$self->{textvariable}}, "\n" +; print "Widget onChange : ",$self->{widget}, "\n"; unless($self->{isChanged}) { print "unless isChaned ", $self->{value}, "|",${$self->{textvariab +le}}, "\n"; $self->{isChanged} = 1 if $self->{value} ne ${$self->{textvari +able}}; } $self->setValue(${$self->{textvariable}}); } sub setValue { my ($self,$value) = @_; $value = buildPath($value); $self->_setValue($value); } sub _setValue { my ($self,$value) = @_; ${$self->{textvariable}} = $value; $self->{value} = $value; $self->{widget}->xview('end'); } sub setDir { my $self = shift; my $mw = shift; print "Inside setDir 1 : pkg $self || $self->{textvariable} ||shif +ted $mw ## \n"; my $dir = $self->{widget}->chooseDirectory(-initialdir => $self->{ +value}); print "Inside setDir 2 : pkg $self || $self->{textvariable} ## \n" + ; if(defined $dir) { ${$self->{textvariable}} = $dir; $self->onChange() } } sub buildPath { my $path = shift; $path = File::Spec->canonpath($path); print "buildPath : After canonpath: $path :\n" ; if ( substr( $path, 0, 2 ) eq ".." ) { $path = getcwd . "/" . $path; print "buildPath : After substr and concat: $path :\n"; } # remove the .. my @dirs = File::Spec->splitdir($path); print "buildPath dirs: @dirs ||| \n" ; for ( my $i = @dirs - 1 ; $i > 0 ; $i-- ) { my $skip = 0; while ( $dirs[$i] eq ".." ) { $dirs[$i] = ""; $i--; $skip++; } for ( ; $skip > 0 ; $skip-- ) { if ( substr( $dirs[$i], 0, 1 ) ne '$' ) { $dirs[$i] = ""; } $i-- if $skip > 1; } } $path = File::Spec->catdir(@dirs); print "buildPath : After spec:catdir : $path :\n" ; $path =~ s/\\/\//g; $retPath =~ s/\\/\//g; print "buildPath : After final substn : $path || $retPath \n"; return $path ; } 1;

    I just pasted the portion of code from my work. The main problem is from buildPath(), I have to return a path in a way so that the '/' is not deleted and displayed in the gui.
    Also just a mere concatenation like $value .= "/"; will not serve my purpose.

    Thanks. Please help

      I get your code to run, and observe the error of / not being accepted. Your code is a bit complicated, and I will look at it, but just as a first comment I noticed one oddity. If you enter a \ instead of a /, a / will be inserted properly. ?? This link perl-getcwd-ending-forward-slashes may yield a clue.

      I'm wondering why you even use File::Spec's catdir? The docs say

      catdir
      Concatenate two or more directory names to form a complete path ending with a directory. But remove the trailing slash from the resulting string, because it doesn't look good, isn't necessary and confuses OS/2. Of course, if this is the root directory, don't cut off the trailing slash :-)

      When I comment out all the File::Spec canonpath and catdir lines from your script, it adds a / just fine.


      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh

      G'day ghosh123,

      The Entry widget is accepting a forward slash (/)!

      I added an additional print statement to sub buildPath {...}:

      sub buildPath { my $path = shift; print "buildPath : BEFORE canonpath: $path :\n" ; $path = File::Spec->canonpath($path); print "buildPath : After canonpath: $path :\n" ; ...

      The output before and after canonpath() is:

      ... buildPath : BEFORE canonpath: /home/ghoshabh/ : buildPath : After canonpath: /home/ghoshabh : ...

      Here's a workaround which I've successfully tested:

      sub buildPath { my $path = shift; my $trailing = $path =~ /\/$/ ? '/' : ''; ... return $path . $trailing; }

      -- Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://997437]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (5)
As of 2014-09-18 01:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (103 votes), past polls