package Tk::MenuEntry;

use Tk qw(Ev);
use strict;
use vars qw(@ISA $VERSION);

@ISA = qw(Tk::Derived Tk::Frame);
$VERSION = "0.02";

Construct Tk::Widget 'MenuEntry';

my $BITMAP;

sub ClassInit {
    my($class,$mw) = @_;

    unless(defined($BITMAP)) {
	$BITMAP = __PACKAGE__ . "::downarrow";

	my $bits = pack("b12"x5,".1111111111.",
				"..11111111..",
				"...111111...",
				"....1111....",
				".....11.....");

	$mw->DefineBitmap($BITMAP => 12,5, $bits);
    }
}

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

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

    my $sf = $me->Frame;

    my $b = $sf->Button(
	-bitmap => $BITMAP,
	-anchor => 'center',
	-highlightthickness => 0,
    )->pack(-fill => 'both', -expand => 1);

    $me->Advertise(Button => $b);

    $sf->packPropagate(0);
    $sf->GeometryRequest($b->ReqWidth + 2,1);
    $sf->pack(-side => 'right', -fill => 'y');

    my $e = $me->Entry(
	-borderwidth => 0,
	-highlightthickness => 0,
    )->pack(
	-side => 'left',
	-fill => 'both',
	-expand => 1
    );

    # popup shell for listbox with values.
    my $c = $me->Toplevel(-bd => 2,-relief => "raised");
    $c->overrideredirect(1);
    $c->withdraw;
    my $sl = $c->ScrlListbox(
	-scrollbars => 'oe',
	-selectmode => "browse",
	-exportselection => 0,
	-bd => 0,
	-width => 0,
	-highlightthickness => 0,
	-relief => "raised"
    )->pack(
	-expand => 1,
	-fill => "both"
    );

    $me->Advertise(Popup => $c);
    $me->Advertise(Listbox => $sl);

    $b->bind('<1>', [ $me, 'ButtonDown']);

    $b->bind('<ButtonRelease-1>', [$me, 'ButtonUp', $b]);
    $me->bind('<ButtonRelease-1>', [$me, 'ButtonUp', $me]);

    $sl = $sl->Subwidget('scrolled');

    $sl->bind('<ButtonRelease-1>', [$me, 'ButtonUp', $sl, Ev('index',Ev('@'))]);

    $me->ConfigSpecs(
	-background  => [SELF => qw(background  Background),  "#d9d9d9"],
	-borderwidth => [SELF => qw(borderWidth BorderWidth), 2],
	-relief	     => [SELF => qw(relief      Relief),      'sunken'],
	-highlightthickness
		     => [SELF => qw(highlightThickness HighlightThickness),2],
	-maxlines    => [PASSIVE => qw(maxLines MaxLines), 10],
	-menucreate  => [CALLBACK => undef, undef, undef],
    );

    $me->Default(Entry => $e);

    $me;
}

sub ButtonDown {
    my ($me) = @_;

    return
	if ($me->cget(-state) =~ /disabled/);

    my $tl = $me->Subwidget('Popup');
    if ($tl->ismapped) {
	$me->Unpost;
    } else {
	$me->Post;
    }
}

sub ButtonUp {
    my ($me,$where,$index) = @_;

    return
	if ($me->cget(-state) =~ /disabled/);

    my $tl = $me->Subwidget('Popup');

    if ($tl->ismapped) {
	if($where->isa('Tk::Button')) {
	    my $lb = $me->Subwidget("Listbox");

	    $lb->selectionClear(0,'end');
	    $lb->selectionSet(0);
	}
	else {
	    if($where->isa('Tk::Listbox')) {
		my $sel = $where->get($index);
		my $e = $me->Subwidget('Entry');
		$e->delete(0,'end');
		$e->insert(0,$sel);
	    }
	    $me->Unpost;
	}
    }
}

sub listInsert	{ shift->Subwidget('Listbox')->insert(@_) }
sub listGet	{ shift->Subwidget('Listbox')->get(@_)	  }
sub listDelete	{ shift->Subwidget('Listbox')->delete(@_) }

sub Unpost {
    my ($me) = @_;
    my $tl = $me->Subwidget('Popup');

    if ($tl->ismapped) {
	$tl->withdraw;
	$me->grabRelease;
	$me->Subwidget('Button')->butUp;
    }
}

sub Post {
    my ($me) = @_;
    my $tl = $me->Subwidget('Popup');

    unless($tl->ismapped) {
	my $mc = $me->{Configure}{-menucreate};

	$mc->Call($me)
	    if defined $mc;

	my $lb = $me->Subwidget("Listbox");
	my $x = $me->rootx;
        my $y = $me->rooty + $me->height;
	my $size = $lb->size;
	my $msize = $me->{Configure}{-maxlines};

	$size = $msize
	    if $size > $msize;
	$size = 1
	    if(($size = int($size)) < 1);

	$lb->configure(-height => $size);
	# Scrolled turns propagate off, but I need it on
	$lb->Tk::pack('propagate',1);
	$lb->update;

	$x = 0
	    if $x < 0;
	$y = 0
	    if $y < 0;

	my $vw = $me->vrootwidth;
	my $rw = $tl->ReqWidth;
	my $w = $me->rootx + $me->width - $x;

	$w = $rw
	    if $rw > $w;
	$x =  $vw - $w
	    if(($x + $w) > $vw);

	my $vh = $me->vrootheight;
	my $h = $tl->ReqHeight;

	$y = $vh - $h
	    if(($y + $h) > $vh);

	$tl->geometry(
	    sprintf("%dx%d+%d+%d",$w, $h, $x, $y)
	);

	$tl->deiconify;
	$tl->raise;

	$me->Subwidget("Entry")->focus;

	$tl->configure(-cursor => "arrow");

	$lb->selectionClear(0);
	$lb->yview('moveto',0);
	$me->grabGlobal;
    }
}

1;