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

Hello, i have kind of a weird problem with a PerlTk-GUI-tool which i am programming for a customer. The tool works great on my Linux-environment, but not on the one of my customer. We both use the standard Perl v5.8.5 and Perl v5.8.7.

The problem is, that on my customers system the script/GUI freezes each time, it tries to open up a new TopLevel-window, a dialogbox like getOpenFile or these small balloon-helpboxes. The script allways freezes, before these features would show up on the screen.

Also the script freezes in most cases when i call the methods: I tried out a lot and checked any callbacks and bindings on my script, wether one of those could be the reason for that, but it isn't.

I suspect the window manager or the X Server to block each attempt to take control, for instance by creating new windows etc.; But i am really not sure about that. Maybe it's some kind of safety guideline, which avoids programms from doing things like that.

Does anyone maybe have an idea, what could be the reason and where to search? Is there maybe some quite simplier explanation or options i should check first?

Below is some part of the code i am using with the MainWindow setup and the methods causing the problems.

Thanks,

Markus.
#!/usr/bin/perl -w use strict; use warnings; use diagnostics; use Tk; use Tk::Balloon; use Tk::Dialog; use Tk::DialogBox; use Tk::FileSelect; use Tk::Pane; use Tk::BrowseEntry; use Tk::ProgressBar; use Tk::NoteBook; #---------------------- my $version = "1.1.0"; sub init { $initdone = 0; $mw->Walk( sub { $_[0]->destroy } ) if ( Exists( $mw ) ); $mw = MainWindow->new( -background => "#e6e6e6", -title => "ParaWell v$version +", ) if ( not Exists( $mw ) ); #----------------------------------------- sub progress { $frameprogress->MapWindow if ( $_[0] < 1 ); $percents = sprintf( "%d%%", $_[0] * 100 ); $percent = $_[0] * 100; $progressbar->idletasks; $frameprogress->UnmapWindow if ( $_[0] == 1 ); return if ( $_[1] eq $progwhat ); $progwhat = " "; $progwhatlab->idletasks; $progwhat = ( $frameprogress->ismapped ) ? $_[1] : ""; } #---------------------------------- sub addball { return if ( not Exists( $_[0] ) ); my $ball = $_[0]->Balloon( -state => "balloon", -foreground => "#000000", -background => "#ffffaa", -cancelcommand => sub { return 1 }, ); $ball->attach( $_[0], -balloonposition => 'mouse', -msg => ( join "\n", $_[1] +), -cancelcommand => sub { return 1 }, -initwait => 200, ); }
  • Comment on Perl Tk, GUI / Window Manager freezes/blocks when creating new windows, dialogues or balloons
  • Download Code

Replies are listed 'Best First'.
Re: Perl Tk, GUI / Window Manager freezes/blocks when creating new windows, dialogues or balloons
by zentara (Cardinal) on Dec 04, 2009 at 13:25 UTC
    ...when i run your code i get
    Uncaught exception from user code: Global symbol "$initdone" requires explicit package name at ./811053.p +l line 21. Global symbol "$mw" requires explicit package name at ./811053.pl line + 22. Global symbol "$mw" requires explicit package name at ./811053.pl line + 22. Global symbol "$mw" requires explicit package name at ./811053.pl line + 24. Global symbol "$mw" requires explicit package name at ./811053.pl line + 27. Global symbol "$frameprogress" requires explicit package name at ./811 +053.pl line 33. Global symbol "$percents" requires explicit package name at ./811053.p +l line 35. Global symbol "$percent" requires explicit package name at ./811053.pl + line 36. Global symbol "$progressbar" requires explicit package name at ./81105 +3.pl line 37. Global symbol "$frameprogress" requires explicit package name at ./811 +053.pl line 38. Global symbol "$progwhat" requires explicit package name at ./811053.p +l line 40. Global symbol "$progwhat" requires explicit package name at ./811053.p +l line 42. Global symbol "$progwhatlab" requires explicit package name at ./81105 +3.pl line 43. Global symbol "$progwhat" requires explicit package name at ./811053.p +l line 44. Global symbol "$frameprogress" requires explicit package name at ./811 +053.pl line 44. Missing right curly or square bracket at ./811053.pl line 68, at end o +f line ./811053.pl has too many errors. at ./811053.pl line 68
    .... too many errors to look at it..... always cut and paste running code.... don't type your code in..... and test download it after posting.... to test that it actually runs

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
Re: Perl Tk, GUI / Window Manager freezes/blocks when creating new windows, dialogues or balloons
by biohisham (Priest) on Dec 04, 2009 at 11:27 UTC
    The code you posted doesn't reproduce the behavior you are describing:
    • The 'init' block isn't scoped.
    • The variables aren't localized to reduce 'strictures' and warnings clutter.
    • It doesn't include the method calls you reported to cause it to hang (except for idletasks) nor the context these methods calls are invoked in, neither.
    It'd be prudent to replicate the same problem you're facing in a summary code and make the code as much self-spoken as possible to receive better responses and direction...

    Best of Luck vertigomagic..


    Excellence is an Endeavor of Persistence. Chance Favors a Prepared Mind.
      Oooh, sorry! The first problem is: The original code is much too big and copyright-sensitive aswell, so i just extracted some of the routines which cause the problems.

      I extracted the following test example, which i am pretty sure would cause the same errors. The script either freezes, when the cursor rests more than 200ms over the first test button when the ballloon help would normally show up, or when you hit the second button and the getOpenFile-dialog normally would open:
      #!/usr/bin/perl -w use strict; use warnings; use Tk; use Tk::Balloon; use Tk::Dialog; use Tk::DialogBox; #-------------------------------------------- my $mw = MainWindow->new( ); #-------------------------------------------- my $balloonbutt = $mw->Button( -text => 'Test Balloon MouseOver', ) ->grid( -column => 10, -row => 10, -padx => 10, -pady => 10, ); my $ball = $balloonbutt->Balloon( -state => "balloon", -cancelcommand => sub { return 1 }, ); $ball->attach( $balloonbutt, -balloonposition => 'mouse', -msg => "Balloon Test", -cancelcommand => sub { return 1 }, -initwait => 200, ); #-------------------------------------------- $mw->Button( -text => 'Browse', -command => sub { my $types = [ [ 'Modellfiles' , ' +*.fif *.nas *.bdf' ], [ 'All Files' , ' +*' ] ]; my $file = $mw->getOpenFile( -filetypes => $ty +pes, -title => "Te +st getOpenFile", ); }, ) ->grid( -column => 20, -row => 10, -padx => 10, -pady => 10, ); #-------------------------------------------- MainLoop();
      The second, major problem: The error only occurs on the environment of my customer. And i don't get too many chances, to try out this and that all the time on this system. I am expectet to provide my customer some code, which runs ... ;-) I know, stupid me selling scripts, not beeing evaluated on the environment which they're running on later ... ;-)
      On my environment, the test script above runs absolutely normal without any problems.

      Markus.