slydog has asked for the wisdom of the Perl Monks concerning the following question:
$top->protocol( 'WM_DELETE_WINDOW', sub{} );
sub getSearch { my $dialog = $top->DialogBox( -title => "MxFWcon Search", -buttons => [ "Search", "Cancel" ], ); $dialog->add("Label", -text=> "MxFWcon Search")->grid(-row => '0', + -column => '0', -columnspan => 2); $dialog->add("Label", -text=> "IP:")->grid(-row => '2', -column => + '0', -stick => "e"); my $ip = $dialog->add("Entry", -width => 20)->grid(-row => '2', -c +olumn => '1'); return ($dialog, $ip); } sub getResults { my $list = shift; my $dialog = $top->DialogBox( -title => "MxFWcon Search", -buttons => [ "Done" ], ); $dialog->add("Label", -text=> "MxFWcon Search")->grid(-row => '0', + -column => '0', -columnspan => 2); my $scroll = $dialog->add("Scrollbar", -orient => 'vertical')->gri +d(-row => '2', -column => '1'); my $ltb = $dialog->add("Listbox", -background => 'white', -height => '4', -width => '30', -yscrollcommand => ['set' => $scroll], )->grid(-row => '2', -column => '0'); $scroll->configure(-command => ['yview' => $ltb]); foreach my $item(keys %$list) { $ltb->insert('end', $list->{$item}); } $ltb->bind("<Double-1>", sub { searchGet($dialog, $ltb);}); return ($dialog); } sub searchGet { my ($dialog, $ltb) = @_; if ((my $sel = $ltb->curselection()) !~ /^$/) { my $ip = $ltb->get($sel); my $lk1 = $vars->{lk1}; my @ips = $lk1->get(0,'end'); my $x = 0; foreach my $item(@ips) { if ($item eq $ip) { setBlock($x); $dialog->destroy; return; } $x++; } } return; } sub setBlock { my $sel = shift; my $lk1 = $vars->{lk1}; $lk1->selection('clear', 0, 'end'); $lk1->selection('set', $sel); $lk1->see($sel); } sub search { my $lk1 = $vars->{lk1}; my ($dialog, $ip) = getSearch(); my $ans = $dialog->Show(); if ($ans eq "Search") { my $sip = $ip->get; $sip =~ s/\s*//g; my %list; my @ips = $lk1->get(0,'end'); my $x = 0; foreach my $item(@ips) { if ($item =~ /^$sip/) { $list{$x} = $item; } $x++; } my $found = keys(%list); if ($found > 1) { my $res = getResults(\%list); $res->Show(); } elsif ($found == 1) { my ($x, $y) = each(%list); setBlock($x); } else { getMess("IP: $sip NOT found in the list", "MxFWcon Sea +rch"); } } return; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Problems with perl/Tk dialogbox destroy
by bbfu (Curate) on Jun 11, 2003 at 22:02 UTC | |
|
Re: Problems with perl/Tk dialogbox destroy
by bobdeath (Scribe) on Jun 11, 2003 at 19:51 UTC |