sub Popup { my $w = shift; $w->configure(@_) if @_; $w->idletasks; my ($mw,$mh) = ($w->reqwidth,$w->reqheight); my ($rx,$ry,$rw,$rh) = (0,0,0,0); my $base = $w->cget('-popover'); my $outside = 0; if (defined $base) { if ($base eq 'cursor') { ($rx,$ry) = $w->pointerxy; } else { $rx = $base->rootx; $ry = $base->rooty; $rw = $base->Width; $rh = $base->Height; } } else { my $sc = ($w->parent) ? $w->parent->toplevel : $w; $rx = -$sc->vrootx; $ry = -$sc->vrooty; $rw = $w->screenwidth; $rh = $w->screenheight; } my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh); ($X,$Y) = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh); # adjust to not cross screen borders if ($X < 0) { $X = 0 } if ($Y < 0) { $Y = 0 } if ($mw > $w->screenwidth) { $X = 0 } if ($mh > $w->screenheight) { $Y = 0 } $w->Post($X,$Y); $w->waitVisibility; } sub Post { my ($w,$X,$Y) = @_; $X = int($X); $Y = int($Y); $w->positionfrom('user'); $w->geometry("+$X+$Y"); # $w->MoveToplevelWindow($X,$Y); $w->deiconify; $w->raise; }