Popup($pop_menu,-popover => "cursor", -popanchor => 'nw'); .... sub Popup { package Tk::Wm; 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; ## Bug #28238 for Tk: Tk::Menu->Popup never returns (Win32) $w->update; }