# Copyright (c) 1995-1999 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.
*AUTOLOAD
= \
&Tk
::Widget
::AUTOLOAD
;
# There are issues with this stuff now we have Tix's wm release/capture
# as toplevel-ness is now dynamic.
$VERSION = '3.023'; # $Id: //depot/Tk8/Tk/Wm.pm#23 $
use Tk::Submethods ( 'wm' => [qw(grid tracing)] );
Direct Tk
::Submethods
('wm' => [qw(aspect client colormapwindows command
deiconify focusmodel frame geometry group
iconbitmap iconify iconimage iconmask iconname
iconwindow maxsize minsize overrideredirect positionfrom
protocol resizable saveunder sizefrom state title transient
$obj->bindtags([ref($obj),$obj,'all']);
$cw->ConfigSpecs('-overanchor' => ['PASSIVE',undef,undef,undef],
'-popanchor' => ['PASSIVE',undef,undef,undef],
'-popover' => ['PASSIVE',undef,undef,undef]
my ($w,$x,$y,$width,$height) = @_;
$w->geometry($width.'x'.$height);
$w->MoveToplevelWindow($x,$y);
my $cb = $w->protocol('WM_DELETE_WINDOW');
$w->positionfrom('user');
# $w->geometry("+$X+$Y");
$w->MoveToplevelWindow($X,$Y);
my ($anchor,$X,$Y,$w,$h) = @_;
$anchor = 'c' unless (defined $anchor);
$Y += ($anchor =~ /s/) ?
$h : ($anchor =~ /n/) ?
0 : $h/2;
$X += ($anchor =~ /e/) ?
$w : ($anchor =~ /w/) ?
0 : $w/2;
my ($mw,$mh) = ($w->reqwidth,$w->reqheight);
my ($rx,$ry,$rw,$rh) = (0,0,0,0);
my $base = $w->cget('-popover');
($rx,$ry) = $w->pointerxy;
my $sc = ($w->parent) ?
$w->parent->toplevel : $w;
my ($X,$Y) = AnchorAdjust
($w->cget('-overanchor'),$rx,$ry,$rw,$rh);
($X,$Y) = AnchorAdjust
($w->cget('-popanchor'),$X,$Y,-$mw,-$mh);
my $over = (@_) ?
shift : 0;
my $width = $w->screenwidth;
my $height = $w->screenheight;
$w->GeometryRequest($width,$height);
$w->overrideredirect($over & 1);
$w->GeometryRequest($width,$height);
return $w->wm('iconposition',$1,$2) if $_[0] =~ /^(\d+),(\d+)$/;
if ($_[0] =~ /^([+-])(\d+)([+-])(\d+)$/)
my $x = ($1 eq '-') ?
$w->screenwidth-$2 : $2;
my $y = ($3 eq '-') ?
$w->screenheight-$4 : $4;
return $w->wm('iconposition',$x,$y);
$w->wm('iconposition',@_);