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

Re^3: Perl Tk , MainLoop, destroy function problem

by zentara (Archbishop)
on Feb 21, 2013 at 12:18 UTC ( #1019936=note: print w/replies, xml ) Need Help??

in reply to Re^2: Perl Tk , MainLoop, destroy function problem
in thread Perl Tk , MainLoop, destroy function problem

Hi, Yes I know the problem and it is why I mentioned to you the fact that Hlist maintains an internal counter that can't ( as far as I know ) be changed. In essence what it means is that once you itemCreate a path 0 ( or 1,2,3 etc) it is always maintained inside the Hlist. So if you delete path 0 ( or which ever path you please ) you cannot itemCreate it again, you can only itemConfigure it. You can get the number of paths in the Hlist by using my @entries = $h->info('children');

Here is a simple example which shows all the methods fairly clearly.

#!/usr/bin/perl use strict; use Tk; use Tk::HList; my $mw = MainWindow->new(); #create some sample data my %data; foreach (0..100) { $data{$_}{'name'} = 'name'.$_; $data{$_}{'id'} = rand(time); } #get random list of keys my @keys = keys %data; ################# my $h = $mw->Scrolled( 'HList', -header => 1, -columns => 2, -width => 30, -height => 60, -takefocus => 1, -background => 'steelblue', -foreground =>'snow', -selectmode => 'single', -selectforeground => 'pink', -selectbackground => 'black', # -browsecmd => \&browseThis, )->pack(-side => "left", -anchor => "n"); my $nameh = $h->header('create', 0, -text => ' Name ', -borderwidth => 3, -headerbackground => 'steelblue', -relief => 'raised'); my $idh = $h->header('create', 1, -text => ' ID ', -borderwidth => 3, -headerbackground => 'lightsteelblue', -relief => 'raised'); foreach (@keys) { my $e = $h->addchild(""); #will add at end $h->itemCreate ($e, 0, -itemtype => 'text', -text => $data{$_}{'name'}, ); $h->itemCreate($e, 1, -itemtype => 'text', -text => $data{$_}{'id'}, ); } my $button = $mw->Button(-text => 'exit', -command => sub{exit})->pack; my $sortid = $mw->Button(-text => 'Sort by Id', -command => [\&sort_me,1] )->pack; MainLoop; ######################################################### sub sort_me{ my $col = shift; my @entries = $h->info('children'); my @to_be_sorted =(); foreach my $entry(@entries){ push @to_be_sorted, [ $h->itemCget($entry,0,'text'), $h->itemCget($entry,1,'text') ]; } my @sorted = sort{ $a->[$col] cmp $b->[$col] } @to_be_sorted; my $entry = 0; foreach my $aref (@sorted){ # print $aref->[0],' ',$aref->[1],"\n"; $h->itemConfigure( $entry, 0, 'text' => $aref->[0] ); $h->itemConfigure( $entry, 1, 'text' => $aref->[1] ); $entry++; } $mw->update; }

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

Replies are listed 'Best First'.
Re^4: Perl Tk , MainLoop, destroy function problem
by ghosh123 (Monk) on Feb 22, 2013 at 07:18 UTC


    Thank you for your reply !
    But still one more thing is not working, though I am following the cpan doc for HList. I have tried using both itemExists($entrypath,$col) and info(exists, $entrypath), but of no use.
    The scenario is like :
    The gui always has two columns , no issue on that. But first time the gui has one row, so entrypath 0 is added and I used itemCreate() to populate values.
    Next time due to updation of the input file the gui should have some 3 rows with entirely new data. This time for entrypath 0 , the if(itemExists) returns true and I am using itemConfigure inside the if block. All fine so far. But next iteration for entrypath 1, itemExists should fail and I should be able to go to the else block to add() and itemCreate(), but I am not able to.
    I am getting following error :

    XS_Tk__Callback_Call error:Entry "1" not found at /user/perl_5.8.8/lib/ line 250.
    Tk::Error: Entry "1" not found at /opt/perl_5.8.8/lib/ line 250.
    Tk::Error:: Too many arguments.
    Tk callback for .frame1.frame.hlist
    Tk::After::repeat at /opt/perl_5.8.8/lib/Tk/ line 79
    [repeat,[{},after#12,5000,repeat,&main::clear_data]]: No match.
    Here is the code snipppet which is not working

    if($hl->itemExists($path,0)){ #if($hl->info(exists, $path)){ # tried both info and itemExist alterna +tely, but :( print "itemexists ...\n"; $hl->itemConfigure($path,0,-text=> $hash->{$user}->{$tool}->{tool} +); $hl->itemConfigure($path,1,-text=> $hash->{$user}->{$tool}->{issue +d}) ; $hl->itemConfigure($path,2,-text=> $hash->{$user}->{$tool}->{inuse +}); $hl->itemConfigure($path,3,-text=> $hash->{$user}->{$tool}->{in +use}, -style => $color); } else { print "Inside else ....\n"; $hl->add($path); $hl->itemCreate($path,0,-text=> $hash->{$user}->{$tool}->{tool}); $hl->itemCreate($path,1,-text=> $hash->{$user}->{$tool}->{issued}) ; $hl->itemCreate($path,2,-text=> $hash->{$user}->{$tool}->{inuse}); $hl->itemCreate($path,3,-text=> $hash->{$user}->{$tool}->{inuse}, -style => $color); }
      You didn't provide a complete code snippet which demonstrates your problem, but from your code it looks like you have the right concept. However, from the error message you provided, it says you have "too many arguments", and just from my intuition, I think the problem is that you say you have just 2 columns, yet you are trying to itemCreate 4 in your add($path).

      Related to that, and I'm not sure about it, but if you know that you have 4 columns in your subsequent data, but only 1 initially, you may want to create that first row with 4 columns with the last 3 empty, thereby making available for itemConfigure. Otherwise, you will need to figure out how to change that entry from a 1 column to a 4 column path. I hope that makes sense.

      Another possible problem is that you may be running into conflicts with your 2 timers. Where 1 timer is clearing out data while another is trying to write, but we don't see what your code is actually doing. Can you make a small running example with some fake data, that demonstrates your problem?

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

        To explain you better, I am copy/pasting the entire snippet run on a small input file (info.txt). The info.txt content is following :

        location usa age 22 phone 201
        location germany age 22 phone 202
        location france age 23 phone 101

        Above info.txt is having 3 sets of data (2 for alex and 1 for martin). To test the application , you have to first keep only one set of data for alex only, then you replace the file by the above one to see the "Entry '1' not found Error"

        One apology, the regular expression is working fine for me. If it does not work for you, please correct it. I have kept the file content as simple as possible. Pardon me please on this.
        One more thing is, I have kept an entry box above to let the user to set the frequency of refreshing the gui. How can I put that Entry box textvariable to the repeat function so that it picks it up. Default should be 5000.

        Following is the code

        use Tk; use Tk::HList; use Tk::ItemStyle; use Data::Dumper; my $user = $ARGV[0] || 'alex'; my $hash = {}; my ($location,$age,$use,$vendor,$feature); my $sec; #gui variables my ($hl,$ok,$alert); # Making the Gui my $mw = new MainWindow; $mw->geometry("500x200"); my $userframe = $mw->Frame(-width=>5,-height=>10)->pack(-side=>'top',- anchor=>'nw'); $userframe->Label(-text => "USER: $user")->pack(-side => 'left', -anch +or => 'nw',-padx => 0); $userframe->Label(-text => "Set time")->pack(-side => 'left',-anchor = +> 'w',-padx => 0); my $frequency = $userframe->Entry(-width=>5,-textvariable=> \$sec)->pa +ck(-side => 'left',-anchor => 'nw',-padx => 0); my $hlistframe = $mw->Frame()->pack(-fill => 'both', -expand => 1); $hl = $hlistframe->Scrolled('HList', -scrollbars => 'ose', -columns =>4 , -header => 1, -width => 100, -command => sub {print "AAA\n";}, -selectmode => 'browse', )->pack(-fill => 'both',-expand =>1 ); my $label1 = $hl->Label(-text => "location", -anchor => 'w'); $hl->headerCreate(0,-itemtype => 'window',-widget => $label1); my $label3 = $hl->Label(-text => "Age", -anchor => 'w'); $hl->headerCreate(1,-itemtype => 'window',-widget => $label3); my $label4 = $hl->Label(-text => "phone", -anchor => 'w'); $hl->headerCreate(2,-itemtype => 'window',-widget => $label4); open_report(); my $timer1 = $mw->repeat(5000, \&clear_data); MainLoop; sub clear_data{ print "Inside clear data \n"; read_file(); my $path = 0; for my $locationkey (sort keys %{$hash->{$user}}){ _refreshData($path,$locationkey); $path++; } } sub _refreshData { my $path = shift; my $location = shift; print "Inside refreshdata $path | $location \n"; my $availbl = $hash->{$user}->{$location}->{age}; my $chk = $hash->{$user}->{$location}->{phone}; if($hl->itemExists($path,0)){ #if($hl->info(exists, $path)){ print "itemexists ...\n"; $hl->itemConfigure($path,0,-text=> $hash->{$user}->{$location}->{l +ocation}); $hl->itemConfigure($path,1,-text=> $hash->{$user}->{$location}->{a +ge}) ; $hl->itemConfigure($path,2,-text=> $hash->{$user}->{$location}->{p +hone}); } else { print "Inside else ....\n"; $hl->add($path); $hl->itemCreate($path,0,-text=> $hash->{$user}->{$location}->{loca +tion}); $hl->itemCreate($path,1,-text=> $hash->{$user}->{$location}->{age} +) ; $hl->itemCreate($path,2,-text=> $hash->{$user}->{$location}->{phon +e}); } } sub read_file { print "Inside read file \n"; open(FP, "< info.txt"); while(<FP>){ if(/location (\w+) age (\d+) phone (\d+)/){ ($location,$age,$use) = ($1,$2,$3); print "$1 $2 $3\n"; } if (/^$user\s*/){ $hash->{$user}->{$location}->{location} = $location; $hash->{$user}->{$location}->{age} = $age; $hash->{$user}->{$location}->{phone} = $use; } } close(FP); } sub open_report{ read_file(); my $path = 0; for my $locationkey (sort keys %{$hash->{$user}}){ _insertData($path,$locationkey); $path++; } } sub _insertData { print "Inside insertdata\n"; my $path = shift; my $location = shift; print "Inside insertdata $path | $location \n"; $hl->add($path); $hl->itemCreate($path,0,-text=> $hash->{$user}->{$location}->{loca +tion}); $hl->itemCreate($path,1,-text=> $hash->{$user}->{$location}->{age} +) ; $hl->itemCreate($path,2,-text=> $hash->{$user}->{$location}->{phon +e}); } + +

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (8)
As of 2016-09-28 20:57 GMT
Find Nodes?
    Voting Booth?
    Extraterrestrials haven't visited the Earth yet because:

    Results (540 votes). Check out past polls.