### Test.pl
use KMenueTest;

use Tk;
my $w = KMenueTest->new;

MainLoop;

package KMenueTest;

use strict;
use Tk;
use Tk::Toplevel;

sub new
{
    my($class) = @_;
    my $this = bless({
        MW => MainWindow->new
       }, $class);
    
    my $lab = $this->{MW}->Label(-text => 'Klick hier')->pack;
    
    $this->{MW}->bind($lab, '<1>' => [ 
        \&Click_Event, $this, Ev('X'), Ev('Y') ]
    );
    
    return $this;
}

sub Click_Event
{
    my($mw, $this, $x, $y) = @_;
    
    $this->Close_KMenue if $this->{KMenueOpen};
    
    my $kmenue = $mw->Toplevel(qw/-bd 1 -relief raised/);
    
    $kmenue->overrideredirect(1);
    $kmenue->geometry(sprintf("+%d+%d", $x, $y));
    
    my %opt = qw/-activebackground darkblue 
        -activeforeground white 
        -width 20 -height 1 -bd 0 -anchor w/;
    
    $kmenue->Button(%opt, -text => "Test1"
        , -command => [ \&Test, $this, 1 ])->pack;
    
    $kmenue->Button(%opt, -text => "Test2"
        , -command => [ \&Test, $this, 2 ])->pack;
    
    $this->{KMenue} = $kmenue;
    $this->{KMenueOpen} = 1;
}

sub Test
{
    my($this, $param) = @_;
    print "Test $param\n";
    $this->Close_KMenue;
}

sub Close_KMenue
{
    my($this) = @_;
    $this->{KMenue}->destroy;
    $this->{KMenue} = undef;
    $this->{KMenueOpen} = 0;
}

1;

$this->{MW}->bind('<FocusOut>', sub {$this->Close_KMenue;});

$this->{MW}->bind('<Leave>', sub { $this->Close_KMenue; });

$kmenue->bind('<Leave>', sub { $this->Close_KMenue; });

package Tk::KMenu;

use strict;
use warnings 'all';

use Tk;
use Tk::Toplevel;

sub new
{
	my( $class, $top ) = @_;			# pick parameters

	my $obj = {					# create reference
		container => $top -> Toplevel(		# create and save new toplevel window
			-bd	=> 1,
			-relief	=> 'raised',
		),
		shadow	  => $top -> Toplevel(		# create a shadow window
			-background	=> '#0f0f0f',	# set the background to really dark grey
		),
		menu	  => [],			# save menu entries
	};
	bless $obj, $class;				# bless the reference

	$obj->{container} -> overrideredirect( 1 );	# delete menu border
	$obj->{shadow}    -> overrideredirect( 1 );	# delete shadow border
	$obj->close;					# don't show menu until ->show

	# if the menu loses focus, close it
	$obj->{container} -> bind(
		'<FocusOut>' => sub {
			$obj->close;
		},
	);

	return $obj;					# return object
} # new

sub add
{
	my( $self, @pairs ) = @_;			# pick parameters

	for( my $i = 0; $i < @pairs; $i += 2 ) {	# iterate over @pairs
		# add a menu entry
		push(
			@{ $self->{menu} },
			$self->{container} -> Button(
				-text		=> $pairs[$i],
				-anchor		=> 'w',
				-relief		=> 'flat',
				-bd		=> 1,
				-command	=> $pairs[$i+1],
			) -> pack(
				-fill		=> 'x',
			),
		);
	} # foreach

	return $self;				# return object
} # add