view release on metacpan or  search on metacpan

lib/Tcl/pTk/Wm.pm  view on Meta::CPAN

# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# Adapted for use with Tcl::pTk 9-21-08

package Tcl::pTk::Wm;

our ($VERSION) = ('1.11');

use warnings;
use strict;

use base qw( Tcl::pTk::Derived );

# There are issues with this stuff now we have Tix's wm release/capture
# as toplevel-ness is now dynamic.

Direct Tcl::pTk::Submethods ('wm' => [qw(aspect attributes capture client colormapwindows command
                       deiconify focusmodel frame geometry group
                       iconbitmap iconify  iconphoto iconmask iconname
                       iconwindow maxsize minsize overrideredirect positionfrom
                        release resizable sizefrom stackorder state title transient
                       withdraw wrapper )]);

sub SetBindtags
{
 my ($obj) = @_;
 
 # Setting bindtags for popup menus causes the menu items to be inactive on linux, so skip
 return if( $obj->isa('Tcl::pTk::Menu') );
         
 $obj->bindtags([ref($obj),$obj,'all']);
}

sub Populate
{
 my ($cw,$args) = @_;
 $cw->ConfigSpecs('-overanchor' => ['PASSIVE',undef,undef,undef],
                  '-popanchor'  => ['PASSIVE',undef,undef,undef],
                  '-popover'    => ['PASSIVE',undef,undef,undef]
                 );
}

# Sub to move a top-level window using the wmGeometry method
#   This is provided for compatibility with perl/tk
#  Usage:
#    $widget->MoveToplevelWindow($x,$y)
#      where: $x/$y are the coords to move the window to.
sub MoveToplevelWindow
{
 my ($w,$x,$y) = @_;
 $w->interp->icall('wm', 'geometry', $w->path, "+$x+$y");
}

# Implementation of the perl/tk 'iconimage' method. 
# This is translated to an 'iconphoto' call, which is only available
#  in more recent (>= 8.5) tk's
sub iconimage{
 my ($w, $photo) = @_;
 $w->interp->icall('wm', 'iconphoto', $w->path, $photo);
}

sub MoveResizeWindow
{
 my ($w,$x,$y,$width,$height) = @_;
 $w->withdraw;
 $w->geometry($width.'x'.$height);
 $w->MoveToplevelWindow($x,$y);
 $w->deiconify;
}

sub WmDeleteWindow
{