Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
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
Replies are listed 'Best First'.
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 meditating upon the Monastery: (14)
As of 2015-07-07 20:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls