merrymonk has asked for the wisdom of the Perl Monks concerning the following question:

Yesterday I got very useful answers to my question about tooltips working on a second top level widget.
This allowed me to get my test program to work.
I used the same method for my production application.
Sadly this did not work.
As the Perl code below shows I set $att_res to the ‘result’ of attaching the balloon.
In both the test program and main application this is returned as 1.
What steps should I take to try to find out why the ‘allegedly’ attached balloon is not working? For example is there any way of testing if the attachment is really there?
I have tried setting the parameter to –initwait to 1 but that did not have any effect.


use strict "vars";
use Tk;
use Tk::TabFrame;
use Tk::Balloon;
my ($a_tbfr, $tab_mw, $frame_wg);
my ($lb_str, $en_str, %tabwg, $tabwg_item, $current_product, $gen_str,
+ $j, $j_str, %wg, $wg_item, $att_res);
my ($msgarea, $balloon_msg, $status_msg, $bl_str);
my ($button_sc, $toplevel_entry_wg, $toplevel_wg, $balloon); 
$current_product = 'unset';
$tab_mw = MainWindow->new;
$tab_mw->Label(-text => 'Tabbed Frame to Check Tooltips')->grid(-row =
+> 0);
# add button that gives additional screen with button
$button_sc = $tab_mw->Button(
    -text => 'See top level widget',
    -command => sub
    {

        $toplevel_wg->deiconify();
        $toplevel_wg->raise();
    })
  ->grid(-row => 2);
# create the message area for tooltips
$msgarea = $tab_mw->Label(-borderwidth => 2, -relief => 'groove')
  ->grid(-row => 3);
# create a ballon for this message area etc
$balloon = $tab_mw->Balloon(-statusbar => $msgarea);
# create a TopLevel widget
$toplevel_wg = $tab_mw->Toplevel();
# create an entry box and two labels for this toplevel widget
$toplevel_wg->Label(-text => "Text above entry box")->grid(-row => 0);
$toplevel_entry_wg = $toplevel_wg->Entry(-width => 20)->grid(-row => 1
+, -column=>0);
$toplevel_wg->Label(-text => "Text below entry box")->grid(-row => 2);
# withdraw the second toplevel widget
$toplevel_wg->withdraw();

$att_res = $balloon->attach($toplevel_entry_wg, -balloonmsg => "toplev
+el entry box balloon/tooltip",
                                -statusmsg  => "toplevel entry box sta
+tus");
print "attach result <$att_res> for toplevel Entry balloon\n";
MainLoop;

[download]

Replies are listed 'Best First'.
Re: Failing toplevel balloon
by zentara (Cardinal) on Feb 17, 2010 at 19:37 UTC
    This part of your code makes no sense to me, but I'm not a big user of balloons. You are trying to create a toplevel widget off of a balloon. 
    # create a ballon for this message area etc
$balloon = $tab_mw->Balloon(-statusbar => $msgarea);
# create a TopLevel widget
$toplevel_wg = $tab_mw->Toplevel();

    [download]
    This is the way to do it. 
    #!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Balloon;

my $mw = tkinit;
my $msg = 'press to change';
my $b = $mw->Button( -text => 'Power calculation',
        -command => sub{$msg = $msg . ' again'},
        -padx => 10,
     )->pack( -side => 'top',
       -anchor => 'center',
       -pady => 3,
     );

my $bln = $mw->Balloon( -background => 'LightYellow' )
                ->attach( $b, -msg =>\$msg );
MainLoop;

    [download]
    Try to make a simple example like that with your TabFrame. Or look at this: 
    #!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::NoteBook;
use Tk::Balloon;

package Tk::NoteBook;

sub BalloonInfo{
     my ($nb,$balloon,$X,$Y,@opt) = @_;
     my $wx = $X - $nb->rootx;
     my $wy = $Y - $nb->rooty;
     my $tab = $nb->identify($wx,$wy);
     unless ($tab){
         $balloon->Deactivate;
         return undef;
     }
     foreach my $opt (@opt)
         {
         my $info = $balloon->GetOption($opt,$nb);
         if ($opt =~ /^-(statusmsg|balloonmsg)$/
             && (ref $info eq 'HASH')){
             return $info->{$tab} if $info->{$tab} ;
         }
         return '';
     }
}

package main;

my $mw = tkinit;
my $statuslabel = $mw->Label()->pack(-side=>'bottom');
my $b = $mw->Balloon(-statusbar=>$statuslabel);
my $nb = $mw->NoteBook()->pack;
for my $tab (qw/tab1 tab2 tab3/){
     my $frame = $nb->add($tab,-label=>$tab);
     $frame->Label(-text => $tab)->pack;
     $frame->Label(-text => 'a Label in '.$tab)->pack;
}
$b->attach($nb,
            -balloonposition  => 'mouse',
             -balloonmsg       =>{tab1=>'Help for tab1',
                                  tab2=>'Help for tab2',
                                  tab3=>'Help for tab3',
                       },
             -statusmsg       =>{tab1=>'Status for tab1',
                                 tab2=>'Status for tab2',
                                 tab3=>'Status for tab3'},
        );
MainLoop;

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
[reply]
[d/l]
[select]
Re: Failing toplevel balloon
by Anonymous Monk on Feb 17, 2010 at 15:57 UTC
    Its working out here and it is showing the message as it is supposed to ...
[reply]
      Sorry I was not clear enough.
      The test case, which is the Perl with this posting, does work for me as well.
      However, I have the problem with a big application which is impossible for me to post. I have used the same methods.
      Therefore I am hoping for some guidance about how to diagnose what is causing the problems in my main application.
[reply]

Back to Seekers of Perl Wisdom