package Tk::PopupButton;

use Tk::Frame;
use Tk::Button;
@ISA = qw/Tk::Frame/;

Construct Tk::Widget 'PopupButton';

sub Populate {
    my($w, $args) = @_;

    my $menu = delete $args->{-menu};

    my $m = $w->Menu(-tearoff => 0,
                     -menuitems => $menu);

    $w->SUPER::Populate($args);

    my $b = $w->Button(-relief => 'groove')->pack(-side => 'left');
    my $ba = $w->Button(-image => $w->Bitmap(-file => 'e:/perl/site/lib/Tk/cbxarrow.xbm'))->pack(-side => 'left', -fill => 'y');

    $ba->bind('<ButtonPress-1>' => [\&popup, $m]);

    $w->ConfigSpecs(DEFAULT => [$b]);
}

sub popup {
    my($w, $m) = @_;
    $m->Popup(-popover => "cursor",
              -popanchor => 's');
}

1;