use Tk;
use Tk::PopupButton;

my $mw = new MainWindow;

my $menu = [[ 'command' => 'Funktion1',
              -command  => sub { print "Funktion1\n"; }],
            [ 'command' => 'Funktion2',
              -command  => sub { print "Funktion2\n"; }]];

$mw->PopupButton(-text => 'weitere Funktionen...',
                 -menu => $menu
                 )->pack();

MainLoop();

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;