package ATR::Tk::UpdateFieldList;

use strict;
use warnings;
use base  qw(ATR::Tk::UpdateField Tk::BrowseEntry);
Tk::Widget->Construct('UFList');

=head1 NAME

ATR::Tk::UpdateFieldList - data-tracking combobox

=head1 DESCRIPTION

Currently hardwired for mouse sex options.  Looks like the widget
styling is far enough out from what we might need, that we won't be
using it?

nb. Creates a toplevel for each widget.

=cut

# $Id: UpdateFieldList.pm,v 1.3 2005/03/02 11:42:06 mca Exp $

#----------------------------------------------------------------------------

sub accessorsChanged {
    my $self = shift;
    $self->bindFocusHighlight;
    my $readWrite = $self->data->canSave;

    $self->bindEntryKeystrokes($readWrite);
    $self->configure(-state => 'readonly') if !$readWrite; # disabled, but allows the button; 

    $self->configure(-normalcolour => $readWrite ? 'white' : 'LightGrey');
}

sub atrPopulatePost {
    my ($self, $args) = @_;

    $self->SUPER::atrPopulatePost($args);

    $self->insert('end', 'M [Male]');
    $self->insert('end', 'F [Female]');
    $self->insert('end', 'N [Not sexed]');

    $self->Subwidget('arrow')->packForget;
    $self->bind('<Enter>' => [ $self => 'insetDropdownButton' ]);
}

sub get {
    my $self = shift;
    my $e = $self->Subwidget('entry');
    return $e->get();
}

sub set { # XXX: prime for sending upstairs to UpdateField
    my ($self, $text) = @_;
    my $e = $self->Subwidget('entry');
    $e->delete(0, 'end');
    $e->insert(0, $text);
    $e->icursor('end');

    # keep tv updated in case we become another widget type
    my $tv = $self->cget('-textvariable');
    $$tv = $text if $tv;
}

sub wantFracSize { # allow extra space for the label and internal padding XXX: remove them!
    my $self = shift;
    my ($x, $y) = $self->SUPER::wantFracSize;
    return ($x + 8, $y);
}

# Hook listbox selection/close
sub LbCopySelection {
    my ($self) = @_;
    $self->SUPER::LbCopySelection; # no args or return value
    my $str = $self->get;
    $self->set($1) if $str =~ /^([MFN]) \[(male|female|not sexed)\]/i; # XXX: bodge; need to decouple list item text from data value
    $self->detectEdit;
}

1;
