sub nudge_widget { my ($w) = @_; my $mw = $w->toplevel; my $geo = $mw->geometry; ($geo =~ /^(\d+)x(\d+)[+](\d+)[+](\d+)$/) or return; my ($w0, $h0, $x, $y) = ($1, $2, $3, $4); my $a_save = [ ]; # Get current -expand and -fill values for a given widget my $c_info = sub { my $a_pack = shift; my ($exp, $fill); for (my $i = 0; $i < @$a_pack; $i += 2) { my ($key, $val) = ($a_pack->[$i], $a_pack->[$i+1]); ($key eq '-expand') and $exp = $val; ($key eq '-fill') and $fill = $val; } return [ $exp, $fill ]; }; # Save each widget's -expand and fill values for (my $this = $w; $this ne $mw; $this = $this->parent) { my $a_pack = $this->packInfo; push @$a_save, $c_info->($a_pack); $this->pack(-expand => 1, -fill => 'both'); } # Grow the main window by 1 pixel, then restore the original size simple_nudge($w); # Restore the original -expand and fill values for each widget for (my $this = $w; $this ne $mw; $this = $this->parent) { my $a_pack = shift @$a_save; my ($exp, $fill) = @$a_pack; $this->pack(-expand => $exp, -fill => $fill); } }