package Tk::MyTest;

require Tk;
require Tk::Toplevel;
require Tk::HList;

our @ISA = qw(Tk::Derived Tk::Toplevel);
our $VERSION = '0.04';

Construct Tk::Widget 'MyTest';

sub Show{
  my ($cw) = @_;
  $cw->Popup();
  $cw->waitVariable(\$cw->{Selected});
  $cw->withdraw;
  $cw->{Selected} = [""] unless(defined $cw->{Selected});
  return wantarray ? @{$cw->{Selected}} : join("; ",@{$cw->{Selected}});
}# Show

sub Populate{
  my ($cw,$args) = @_;
  
  $cw->SUPER::Populate($args);
                  
  my $hl = $cw->Component('ScrlListbox'   => 'test',
                         -width           => 40,
                         -scrollbars      => 'ose',
                         -selectmode      => 'single',
                         -exportselection => 0,
                         -font            => 'Courier 8',
                         ); 
  
  for(1..10){
    $hl->insert('end',$_);
  }
  
  $hl->pack();
  $hl->bind('<Double-1>' => [$cw => 'Accept']);
  
  return $cw;
}# Populate

sub Accept{
  my ($cw) = @_;
  my $ref = [$cw->Subwidget('test')->Getselected()];
  $ref = [""] unless($ref);
  $cw->{Selected} = $ref;
}# Accept

1;

#!/usr/bin/perl

use strict;
use warnings;
use lib qw(perllib);
use Tk;
use Tk::MyTest;

my $mw = tkinit;
$mw->Button( -command => \&test, -text => 'testen' )->pack;
MainLoop;

sub test{
    my $diag   = $mw->MyTest;
    my $retval = $diag->Show;
    warn $retval;
}