sub Show { croak 'DialogBox: "Show" method requires at least 1 argument' if scalar @_ < 1; my $cw = shift; my ($grab) = @_; my $old_focus = $cw->focusSave; my $old_grab = $cw->grabSave; shift if defined $grab && length $grab && ($grab =~ /global/); $cw->Popup(@_); Tk::catch { if (defined $grab && length $grab && ($grab =~ /global/)) { $cw->grabGlobal; } else { $cw->grab; } }; if (my $focusw = $cw->cget(-focus)) { $focusw->focus; } elsif (defined $cw->{'default_button'}) { $cw->{'default_button'}->focus; } else { $cw->focus; } $cw->Wait; &$old_focus; &$old_grab; return $cw->{'selected_button'}; } #### 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; }