package Tk::EntryPullDown;

use vars qw ($VERSION);
$VERSION = '0.01';

use Tk;
use strict;

use base qw (Tk::Frame);

Construct Tk::Widget 'EntryPullDown';

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

  my $pixmap = $cw->Pixmap(-file=>"/home/reatmon/devel/jarl/bitmaps/15/mcl_orderdown.xpm");

  my $borderwidth = $cw->ParseArg($args,"-borderwidth",2);
  my $entrybg = $cw->ParseArg($args,"-entrybackground","white");
  my $entryfg = $cw->ParseArg($args,"-entryforeground","black");
  my $font = $cw->ParseArg($args,"-font","");
  $cw->{ListHeight} = $cw->ParseArg($args,"-listheight",80);

  $cw->{elements} = $cw->ParseArg($args,"-elements",[]);

  $cw->{frame} = $cw->Frame(-background=>$args->{-background},
			    -relief=>$cw->ParseArg($args,"-relief","sunken"),
			    -borderwidth=>$borderwidth,
			   )->pack(-side=>"top",
				   -padx=>1,
				   -pady=>1,
				   -fill=>"both",
				   -expand=>1);

  $cw->{entry} = $cw->{frame}->Entry(-textvariable=>$cw->ParseArg($args,"-textvariable",""),
				     -foreground=>$entryfg,
				     -background=>$entrybg,
				     -highlightthickness=>0,
				     -borderwidth=>0,
				     -relief=>"flat",
				     -width=>$cw->ParseArg($args,"-width",40),
				     -takefocus=>1,
				     (
				      (ref($font) eq "Tk::Font") ?
				      (-font=>$font) :
				      (
				       ($font ne "") ?
				       (-font=>$font) :
				       ()
				      )
				     ),
				    )->pack(-expand=>'true',
					    -fill=>'both',
					    -anchor=>'nw',
					    -side=>'left',
					    -ipadx=>0,
					    -ipady=>0,
					    -padx=>0,
					    -pady=>0,
					   );

  $cw->{button} = $cw->{frame}->Button(-image=>$pixmap,
				       -background=>$cw->ParseArg($args,"-buttonbackground",$args->{-background}),
				       -highlightthickness=>0,
				       -relief=>"raised",
				       -borderwidth=>$cw->ParseArg($args,"-buttonborderwidth",$borderwidth),
				       -takefocus=>0,
				       -command=>sub{
					 $cw->ButtonPressed();
				       },
				      )->pack(-side=>'right',
					      -anchor=>'ne',
					      -fill=>'y',
					      -ipadx=>0,
					      -ipady=>0,
					      -padx=>0,
					      -pady=>0,

					     );

  $cw->{popup} = $cw->{frame}->Toplevel(-relief=>"raised",
					-borderwidth=> 1,
				       );

  $cw->{scrolled} = $cw->{popup}->Scrolled("Listbox",
					   -foreground=>$cw->ParseArg($args,"-listforeground",$entryfg),
					   -background=>$cw->ParseArg($args,"-listbackground",$entrybg),
					   -cursor=>"top_left_arrow",
					   -highlightthickness=>1,
					   -selectmode=>"browse",
					   -scrollbars=>"osoe",
					   -relief=>"flat",
					   -takefocus=>0,
					   (
					    (ref($font) eq "Tk::Font") ?
					    (-font=>$font) :
					    (
					     ($font ne "") ?
					     (-font=>$font) :
					     ()
					    )
					   ),
					  )->pack(-expand=>'true',
						  -fill=>'both',
						  -padx=>0,
						  -pady=>0,
						 );

  $cw->{listbox} = $cw->{scrolled}->Subwidget('listbox');

  $cw->{scrollBarY} = $cw->{scrolled}->Subwidget('yscrollbar');
  $cw->{scrollBarY}->configure(-borderwidth=>1);
  $cw->{scrollBarY}->configure(-cursor=>"top_left_arrow",
			       -relief=>"flat");

  $cw->{entry}->bind('<Return>' => sub {$cw->DoInvokeCallback();});

  $cw->{popup}->bind('<ButtonPress-1>' => sub {$cw->AutoHide ($cw->{popup});});

  $cw->{button}->bind('<Return>' => sub {$cw->{button}->invoke();});

  $cw->{listbox}->bind('<Escape>' => sub {$cw->Hide();});

  $cw->{listbox}->bind('<ButtonRelease-1>' => sub {$cw->Select();});

  $cw->{listbox}->bind('<KeyRelease>' => [sub {$cw->KeySeek(@_);}, Ev ('A')]);

  $cw->{listbox}->bind('<Return>' => sub {$cw->Select();});

  $cw->Hide();

  $cw->SelectionList($cw->{elements});

  return $cw;
}


sub ParseArg {
  my $cw = shift;
  my ($args,$arg,$default) = @_;
  return (exists($args->{$arg}) ? delete($args->{$arg}) : $default);
}


sub ButtonPressed {
  $_[0]->{'Visible'} ? $_[0]->Hide() : $_[0]->Show();
}

sub SelectionList {
  $_[0]->{listbox}->delete ('0', 'end');

  foreach my $l_Entry (sort {$a cmp $b} (ref ($_[1]) eq 'ARRAY' ? @{$_[1]} : @_)) {
    chomp $l_Entry;
    $_[0]->{listbox}->insert ('end', $l_Entry);
  }
}

sub Invoke {
  return (defined ($_[1]) ? $_[0]->{Invoke} = $_[1] : $_[0]->{Invoke});
}

sub Hide {
  my $cw = shift;
  $cw->{popup}->overrideredirect(1);
  $cw->{popup}->transient();
  $cw->{popup}->withdraw();
  $cw->{popup}->grabRelease();
  $cw->{Visible} = 0;
#  $cw->{button}->focus();
}

sub Show {
  my $cw = shift;

  my $l_Geometry = (($cw->cget ('-popupwidth') || $cw->width()).
		    'x'.
		    ($cw->{ListHeight} || 40).
		    '+'.
		    $cw->{entry}->rootx().
		    '+'.
		    ($cw->rooty() + $cw->height())
		   );

  $cw->{popup}->geometry ($l_Geometry);
  $cw->{popup}->deiconify();
  $cw->{popup}->transient();
  $cw->{popup}->raise();
  $cw->{popup}->grabGlobal();

  $cw->{Visible} = 1;
}

sub Select {
  my $cw = shift;
  my @l_Array = ();

  $cw->{entry}->configure ('-state' => 'normal');

  foreach my $l_Row ($cw->{listbox}->curselection()) {
    push (@l_Array, $cw->{listbox}->get ($l_Row));
  }

  my $item = join (',', @l_Array);
  if ($item ne "") {
    $cw->{entry}->delete ('0','end');
    $cw->{entry}->insert('0', $item);
  }
  $cw->Hide();
  $cw->DoInvokeCallback();
}

sub DoInvokeCallback {
  if (ref ($_[0]->{'Invoke'}) eq 'CODE' || ref ($_[0]->{'Invoke'}) eq 'Tk::Callback') {
    $_[0]->afterIdle([$_[0]->{Invoke}, $_[0]]);
  }
}

sub AutoHide {
  my ($l_X, $l_Y, $l_RootX, $l_RootY, $l_Width, $l_Height) =
    ($_[1]->pointerx(),
     $_[1]->pointery(),
     $_[1]->rootx(),
     $_[1]->rooty(),
     $_[1]->width(),
     $_[1]->height(),
    );

  return unless ($l_X >= $l_RootX + $l_Width ||
		 $l_Y >= $l_RootY + $l_Height ||
		 $l_X <= $l_RootX ||
		 $l_Y <= $l_RootY
		);

  $_[0]->Hide();
}

sub KeySeek {
  my ($cw, $p_ListBox, $p_Key) = @_;
  my $l_Index = $p_ListBox->size() - 1;
  my $p_Key = ord ($p_Key);

  return unless ($p_Key > 32);

  while ($l_Index && ord (substr ($p_ListBox->get ($l_Index), 0, 1)) > $p_Key) {
    --$l_Index;
  }

  $p_ListBox->selectionClear (0, 'end');
  $p_ListBox->selectionSet ($l_Index, $l_Index);
  $p_ListBox->see ($l_Index);
}


sub SaveElement {
  my $cw = shift;
  my $newitem = $cw->{entry}->get();
  my $inthere = 0;
  foreach my $item (@{$cw->{elements}}) {
    $inthere = 1 if ($item eq "newitem");
  }
  push(@{$cw->{elements}},$newitem) if ($inthere == 0);

  $cw->SelectionList($cw->{elements});
}


sub GetElements {
  my $cw = shift;
  return @{$cw->{elements}};
}


1;