Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Entry widget not accepting /

by ghosh123 (Monk)
on Oct 05, 2012 at 09:16 UTC ( #997416=perlquestion: print w/ replies, xml ) Need Help??
ghosh123 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monk

What can be the possible reasons for an entry widhet to not accept '/' character. In my gui, I have an entry box where I have to mention some unix path. By default when it launches the widget has a path in it , say '/home/test'. Now if I want to append a path to this default as say '/project', it it ignoring the '/' character and overall it looks like '/home/testproject' which is wrong.

Also I am binding one 'Any-KeyPress' event to that as

$entry->bind('Any-KeyPress', sub {$self->onChange()});

Here $entry is the Tk::Entry object and $self is the blessed reference of a package. The onChange function is getting called but the '/' character is not displayed in the gui and not accepted as well.
Please help.
Thanks.

Comment on Entry widget not accepting /
Download Code
Re: Entry widget not accepting /
by zentara (Archbishop) on Oct 05, 2012 at 10:45 UTC
    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

      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: perlquestion [id://997416]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2014-11-23 06:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (128 votes), past polls