{ my $parent = $jb1 ; my $arrow = $jb1 ->Subwidget('arrow'); my $callback = $arrow->bind(''); $jb1 ->Subwidget('entry')->packForget; $arrow->bind('', [ sub { my( $button, $jbl, $callbackarray ) = @_; warn "fucking @_\n"; warn "button($button) jbl($jbl) callback($callback)\n"; $jbl->Subwidget('entry')->pack(-side => "right", -fill => 'x', -padx => 0, -pady => 0, -expand => 1); my( $cb, @args ) = @$callbackarray; $cb->(@args); }, $parent, $callback, ] ); } #### #!/usr/bin/perl -- use strict; use warnings; use Tk; use Tk::BrowseEntry; Main( @ARGV ); exit( 0 ); sub Tk::BrowseEntry::Popdown { my ($w) = @_; if ( $w->{'_BE_savefocus'} && Tk::Exists( $w->{'_BE_savefocus'} ) ) { $w->{'_BE_savefocus'}->focus; delete $w->{'_BE_savefocus'}; } if ( $w->{'_BE_popped'} ) { my $c = $w->Subwidget('choices'); $c->withdraw; $w->grabRelease; if ( ref $w->{'_BE_grabinfo'} eq 'CODE' ) { $w->{'_BE_grabinfo'}->(); delete $w->{'_BE_grabinfo'}; } $w->{'_BE_popped'} = 0; $w->Subwidget('entry')->packForget; } } sub Tk::BrowseEntry::BtnDown { my ($w) = @_; return if $w->cget( '-state' ) eq 'disabled'; if ($w->{'_BE_popped'}) { $w->Popdown; $w->{'_BE_buttonHack'} = 0; } else { $w->Subwidget('entry')->pack(-side => 'right', -fill => 'x', -expand => 1); $w->update; $w->PopupChoices; $w->{'_BE_buttonHack'} = 1; } } sub Main { my $mw = tkinit(); my $var = 'lelabel'; my $b = $mw->BrowseEntry(-label => "Label", -variable => \$var); $b->insert("end", "opt1"); $b->insert("end", "opt2"); $b->insert("end", "opt3"); $b->Subwidget('entry')->packForget; $b->pack; MainLoop; }