package Tk::BrowseEntry;
use vars qw($VERSION);
$VERSION = '3.030'; # $Id: //depot/Tk8/Tixish/BrowseEntry.pm#30 $
use Tk qw(Ev);
use Carp;
use strict;
require Tk::Frame;
require Tk::LabEntry;
use base qw(Tk::Frame);
Construct Tk::Widget 'BrowseEntry';
sub Populate{my($w,$args)=@_;
$w->SUPER::Populate($args);
my$lpack=delete$args->{-labelPack};
if(not defined$lpack){$lpack=[-side=>'left',-anchor=>'e'];}my$var="";
my$e=$w->LabEntry(-labelPack=>$lpack,-label=>delete$args->{-label},-textvariable=>\$var,);
my$b=$w->Button(-bitmap=>'@'.Tk->findINC('cbxarrow.xbm'));
$w->Advertise('entry'=>$e);
$w->Advertise('arrow'=>$b);
$b->pack(-side=>'right',-padx=>1);
$e->pack(-side=>'right',-fill=>'x',-expand=>1,-padx=>1);
my$c=$w->Toplevel(-bd=>2,-relief=>'raised');
$c->overrideredirect(1);
$c->withdraw;
my$sl=$c->Scrolled(qw/Listbox -selectmode browse -scrollbars oe/);
$w->Advertise('choices'=>$c);
$w->Advertise('slistbox'=>$sl);
$sl->pack(-expand=>1,-fill=>'both');
$w->SetBindings;
$w->{'popped'}=0;
$w->Delegates('insert'=>$sl,'delete'=>$sl,get=>$sl,DEFAULT=>$e);
$w->ConfigSpecs(-listwidth=>[qw/PASSIVE  listWidth   ListWidth/,undef],-listcmd=>[qw/CALLBACK listCmd     ListCmd/,undef],-browsecmd=>[qw/CALLBACK browseCmd   BrowseCmd/,undef],-choices=>[qw/METHOD   choices     Choices/,undef],-state=>[qw/METHOD   state       State         normal/],-arrowimage=>[{-image=>$b},qw/arrowImage ArrowImage/,undef],-variable=>'-textvariable',-colorstate=>[qw/PASSIVE  colorState  ColorState/,undef],-command=>'-browsecmd',-options=>'-choices',DEFAULT=>[$e]);}sub SetBindings{my($w)=@_;
my$e=$w->Subwidget('entry');
my$b=$w->Subwidget('arrow');
$w->bindtags([$w,'Tk::BrowseEntry',$w->toplevel,'all']);
$e->bindtags([$e,$e->toplevel,'all']);
$b->bind('<1>',[$w,'BtnDown']);
$b->toplevel->bind('<ButtonRelease-1>',[$w,'ButtonHack']);
$b->bind('<space>',[$w,'space']);
my$sl=$w->Subwidget('slistbox');
my$l=$sl->Subwidget('listbox');
$l->bind('<ButtonRelease-1>',[$w,'ListboxRelease',Ev('x'),Ev('y')]);
$l->bind('<Escape>'=>[$w,'LbClose']);
$l->bind('<Return>'=>[$w,'Return',$l]);
$w->bind('<1>','BtnDown');}sub space{my$w=shift;
$w->BtnDown;
$w->{'savefocus'}=$w->focusCurrent;
$w->Subwidget('slistbox')->focus;}sub ListboxRelease{my($w,$x,$y)=@_;
$w->ButtonHack;
$w->LbChoose($x,$y);}sub Return{my($w,$l)=@_;
my($x,$y)=$l->bbox($l->curselection);
$w->LbChoose($x,$y)}sub BtnDown{my($w)=@_;
return if$w->cget('-state')eq 'disabled';
if($w->{'popped'}){$w->Popdown;
$w->{'buttonHack'}=0;}else{$w->PopupChoices;
$w->{'buttonHack'}=1;}}sub PopupChoices{my($w)=@_;
if(!$w->{'popped'}){$w->Callback(-listcmd=>$w);
my$e=$w->Subwidget('entry');
my$c=$w->Subwidget('choices');
my$s=$w->Subwidget('slistbox');
my$a=$w->Subwidget('arrow');
my$y1=$e->rooty+$e->height+3;
my$bd=$c->cget(-bd)+$c->cget(-highlightthickness);
my$ht=$s->reqheight+2*$bd;
my$x1=$e->rootx;
my($width,$x2);
if(defined$w->cget(-listwidth)){$width=$w->cget(-listwidth);
$x2=$x1+$width;}else{$x2=$a->rootx+$a->width;
$width=$x2-$x1;}my$rw=$c->reqwidth;
if($rw<$width){$rw=$width}else{if($rw>$width*3){$rw=$width*3;}if($rw>$w->vrootwidth){$rw=$w->vrootwidth;}}$width=$rw;
if($x2>$w->vrootwidth){$x1=$w->vrootwidth-$width;}if($x1<0){$x1=0;}my$y2=$y1+$ht;
if($y2>$w->vrootheight){$y1=$y1-$ht-($e->height-5);}$c->geometry(sprintf('%dx%d+%d+%d',$rw,$ht,$x1,$y1));
$c->deiconify;
$c->raise;
$e->focus;
$w->{'popped'}=1;
$c->configure(-cursor=>'arrow');
$w->grabGlobal;}}sub LbChoose{my($w,$x,$y)=@_;
my$l=$w->Subwidget('slistbox')->Subwidget('listbox');
if((($x<0)||($x>$l->Width))||(($y<0)||($y>$l->Height))){$w->LbClose;}else{$w->LbCopySelection;
$w->Callback(-browsecmd=>$w,$w->Subwidget('entry')->get);}}sub LbClose{my($w)=@_;
my$l=$w->Subwidget('slistbox')->Subwidget('listbox');
$l->selection('clear',0,'end');
$w->Popdown;}sub LbCopySelection{my($w)=@_;
my$index=$w->LbIndex;
if(defined$index){$w->{'curIndex'}=$index;
my$l=$w->Subwidget('slistbox')->Subwidget('listbox');
my$var_ref=$w->cget('-textvariable');
$$var_ref=$l->get($index);
if($w->{'popped'}){$w->Popdown;}}$w->Popdown;}sub LbIndex{my($w,$flag)=@_;
my$sel=$w->Subwidget('slistbox')->Subwidget('listbox')->curselection;
if(defined$sel){return int($sel);}else{if(defined$flag&&($flag eq 'emptyOK')){return undef;}else{return 0;}}}sub Popdown{my($w)=@_;
if($w->{'savefocus'}&&Tk::Exists($w->{'savefocus'})){$w->{'savefocus'}->focus;
delete$w->{'savefocus'};}if($w->{'popped'}){my$c=$w->Subwidget('choices');
$c->withdraw;
$w->grabRelease;
$w->{'popped'}=0;}}sub ButtonHack{my($w)=@_;
my$b=$w->Subwidget('arrow');
if($w->{'buttonHack'}){$b->butUp;}}sub choices{my($w,$choices)=@_;
if(@_>1){$w->delete(qw/0 end/);
my%hash;
my$var=$w->cget('-textvariable');
my$old=$$var;
foreach my $val(@$choices){$w->insert('end',$val);
$hash{$val}=1;}$old=(@$choices)?$choices->[0]:undef unless exists$hash{$old};
$$var=$old;}else{return($w->get(qw/0 end/));}}sub _set_edit_state{my($w,$state)=@_;
my$entry=$w->Subwidget('entry');
my$button=$w->Subwidget('arrow');
if($w->cget('-colorstate')){my$color;
if($state eq 'normal'){$color='gray95';}else{$color=$w->cget(-background)||'lightgray';}$entry->Subwidget('entry')->configure(-background=>$color);}if($state eq 'readonly'){$entry->configure(-state=>'disabled');
$button->configure(-state=>'normal');}else{$entry->configure(-state=>$state);
$button->configure(-state=>$state);}}sub state{my$w=shift;
unless(@_){return($w->{Configure}{-state});}else{my$state=shift;
$w->{Configure}{-state}=$state;
$w->_set_edit_state($state);}}sub _max{my$max=shift;
foreach my $val(@_){$max=$val if$max<$val;}return($max);}sub shrinkwrap{my($w,$size)=@_;
unless(defined$size){$size=_max(map(length,$w->get(qw/0 end/)))||0;;}my$lb=$w->Subwidget('slistbox')->Subwidget('listbox');
$w->configure(-width=>$size);
$lb->configure(-width=>$size);}1;
__END__

