Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # NOTE: Derived from blib/lib/Tk/Wm.pm. |
2 | # Changes made here will be lost when autosplit is run again. | |
3 | # See AutoSplit.pm. | |
4 | package Tk::Wm; | |
5 | ||
6 | #line 93 "blib/lib/Tk/Wm.pm (autosplit into blib/lib/auto/Tk/Wm/Popup.al)" | |
7 | sub Popup | |
8 | { | |
9 | my $w = shift; | |
10 | $w->configure(@_) if @_; | |
11 | $w->idletasks; | |
12 | my ($mw,$mh) = ($w->reqwidth,$w->reqheight); | |
13 | my ($rx,$ry,$rw,$rh) = (0,0,0,0); | |
14 | my $base = $w->cget('-popover'); | |
15 | my $outside = 0; | |
16 | if (defined $base) | |
17 | { | |
18 | if ($base eq 'cursor') | |
19 | { | |
20 | ($rx,$ry) = $w->pointerxy; | |
21 | } | |
22 | else | |
23 | { | |
24 | $rx = $base->rootx; | |
25 | $ry = $base->rooty; | |
26 | $rw = $base->Width; | |
27 | $rh = $base->Height; | |
28 | } | |
29 | } | |
30 | else | |
31 | { | |
32 | my $sc = ($w->parent) ? $w->parent->toplevel : $w; | |
33 | $rx = -$sc->vrootx; | |
34 | $ry = -$sc->vrooty; | |
35 | $rw = $w->screenwidth; | |
36 | $rh = $w->screenheight; | |
37 | } | |
38 | my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh); | |
39 | ($X,$Y) = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh); | |
40 | $w->Post($X,$Y); | |
41 | $w->waitVisibility; | |
42 | } | |
43 | ||
44 | # end of Tk::Wm::Popup | |
45 | 1; |