# Modul Tk/ButtonPopup.pm:

package Tk::PopupButton;

use strict;
use warnings;

use Tk::Frame;
use Tk::Button;

our @ISA = qw/Tk::Frame/;

Construct Tk::Widget 'PopupButton';


sub Populate ($$) {
    my $w    = shift;
    my $args = shift;

    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 =>
                                   Tk->findINC('cbxarrow.xbm')),
                       )
                 ->pack(-side   => 'left',
                        -fill   => 'y',
                       );

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

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

} # sub Populate


sub popup {
    my $w = shift;
    my $m = shift;

    $m->Popup(-popover => "cursor",
              -popanchor => 's',
             );
} # sub popup

1;



# Hauptprogramm:

package main;

use strict;
use warnings;


use Tk;
#use Tk::PopupButton; # anschalten, wenn Paket in Extradatei

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();