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

Hello!

I was looking for documentation on this subject in Google and probably banned me access to this information...)))

I use GUI based on Perl-Tk. This GUI consist of several windows. Sometimes one of them must be unswitchable( I should not be able to switch to other windows of my interface). How I can get resolve this issue in Perl-Tk?

Replies are listed 'Best First'.
Re: unswitchable windows in perl-tk
by choroba (Cardinal) on Apr 28, 2014 at 07:08 UTC
    Just use the -global option for the Show method of a dialog:
    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = 'MainWindow'->new(-title => 'mw'); my $tl1 = $mw->Toplevel(-title => 'tl1'); my $tl2 = $mw->Toplevel(-title => 'tl2'); my $modal = $tl2->Dialog( -title => '2/dialog'); $modal->Show(-global); MainLoop();
    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: unswitchable windows in perl-tk
by zentara (Cardinal) on Apr 28, 2014 at 10:38 UTC
    Additionally, there is the overrideredirect flag. It has some drawbacks, like the window manager controls dissappear, and you are displayed on EVERY virtual desktop, as the first example shows.
    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = tkinit; $mw->geometry("200x300+200+200"); $mw->overrideredirect(1); # set the override-redirect flag $mw->Button( -text => 'Quit', -command => sub { Tk::exit(0) }, )->pack( -side => 'bottom',); MainLoop;
    and here is trick to restore Window Manager controls. Just google for more examples.
    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = tkinit; $mw->geometry("200x300+200+200"); $mw->overrideredirect(1); # set the override-redirect flag $mw->Button( -text => 'Quit', -command => sub { Tk::exit(0) }, )->pack( -side => 'bottom',); $mw->Button( -text => 'Restore WM Controls', -command => \&restore_WM, )->pack( -side => 'bottom',); MainLoop; sub restore_WM{ $mw->withdraw; $mw->overrideredirect(0); # set the override-redirect flag $mw->update; $mw->deiconify; }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      Thanks!
      This is interesting solution.
      But overrideredirected window has no window's decorations...((( I need decorations because some windows must change size or geometry...
        You can change the size and geometry of an overrideredirected window, but you must do it manually. See below for a drag example.

        FWIW, GTK2/GTK3 has a better override than Tk, check out the second example.

        #!/usr/bin/perl use warnings; use strict; use Tk; my $top = MainWindow->new; $top->geometry('200x200+200+200'); $top->overrideredirect(1); $top->Label( -text => 'Click and Drag' )->pack( -expand => 1, -fill => 'both' ); $top->Button( -text => 'Exit', -command => sub { $top->destroy } )->pack; my @deltaxy; $top->bind( '<1>' => \&getdelta ); $top->bind( '<B1-Motion>' => \&mousemove ); MainLoop; sub mousemove { my ( $width, $height, $x, $y ) = split /[+x]/, $top->geometry; $x = $top->pointerx - $deltaxy[0]; $y = $top->pointery - $deltaxy[1]; $top->geometry( $width . 'x' . $height . "+$x+$y" ); } sub getdelta { @deltaxy = ( $top->pointerx - $top->x, $top->pointery - $top->y ); }
        Gtk's better approach.
        #!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2::Gdk::Keysyms; use Gtk2 '-init'; $|++; my $window = Gtk2::Window->new('toplevel'); $window->set_title('Z'); $window ->signal_connect( 'destroy' => \&delete_event ); $window->set_border_width(10); $window->set_size_request(300,200); my $vbox = Gtk2::VBox->new( FALSE, 6 ); $window->add($vbox); $vbox->set_border_width(2); my $hbox= Gtk2::HBox->new( FALSE, 6 ); $vbox->pack_end($hbox,FALSE,FALSE,0); $hbox->set_border_width(2); my $button = Gtk2::Button->new_from_stock('gtk-quit'); $hbox->pack_end( $button, FALSE, FALSE, 0 ); $button->signal_connect( clicked => \&delete_event ); my $button1 = Gtk2::Button->new('Global Grab'); $hbox->pack_end( $button1, FALSE, FALSE, 0 ); $button1->signal_connect( clicked => sub{ my $rc; $rc = Gtk2::Gdk->pointer_grab($window->window,1,['button-press-mask' +,'button-release-mask','pointer-motion-mask'],undef,undef,Gtk2->get_c +urrent_event_time); print "$rc\n"; $rc = Gtk2::Gdk->keyboard_grab($window->window,0,Gtk2->get_current_e +vent_time); print "$rc\n"; } ); $window->set_position('center'); $window->show_all(); $window->signal_connect( 'key_release_event' => \&keyrelease ); $window->signal_connect (event => sub { my ($item, $event) = @_; warn "event ".$event->type."\n"; # print chr(07); #beep return 0; #return 1 prevents window from closing # return 0 lets the signal thru }); Gtk2->main; ##################################### sub delete_event { Gtk2->main_quit; return FALSE; } sub keyrelease { my ( $widget, $event ) = @_; print $event->keyval,"\n"; print chr(07); #beep if ( $event->keyval == $Gtk2::Gdk::Keysyms{q} ) { Gtk2->main_quit; } else { print "key was ", chr( $event->keyval ), "\n"; } }

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