$Tk::LabFrameFmt::VERSION = 1.0;
package Tk::LabFrameFmt;
use base qw(Tk::LabFrame);
use strict;

Construct Tk::Widget 'LabFrameFmt';

sub ClassInit {
    my ($class, $mw) = @_;
    $class->Tk::LabFrame::ClassInit($mw);
}

sub Populate {
    my ($w, $args) = @_;
    $w->Tk::LabFrame::Populate($args);
    $w->ConfigSpecs(
		    -format =>       [qw/PASSIVE format Format /, "%s"],
		    -undefstring =>  [qw/PASSIVE undefstring UndefString "--"/],
		    -uds =>          '-undefstring',
		    -textvariable => [qw/PASSIVE textvariable TextVariable/, undef],
		    -formatcmd =>    [qw/CALLBACK formatCmd FormatCmd /, \&FormatCmd],
		    );
}

sub set {
    my ($w, $value) = @_;
    $w->Tk::LabFrame::Subwidget("label")->configure(-text => $w->Callback(-formatcmd, $w, $value));
}

# The Base calls this routine at the end of any re/configurations.
sub Configured {
    use Tie::Watch;
    my ($w,$args,$changed) = @_;
#    $w->Tk::LabFrame::Configured($args, $changed);
    if (exists $changed->{'-textvariable'}) {
	my $vref = $changed->{'-textvariable'};
	my $st = [ sub {
	    my($watch, $new_val) = @_;
	    my $argv = $watch->Args('-store');
	    $argv->[0]->set($new_val);
	    $watch->Store($new_val);
	}, $w];
	$w->{watch} = Tie::Watch->new(-variable => $vref, -store=> $st);
	$w->OnDestroy( [sub {$_[0]->{watch}->Unwatch}, $w] );
	$w->set($$vref); # set the current value too.
    }
    return exists $w->{'Configure'};
}

sub FormatCmd {
    my ($w, $value) = @_;
    return $w->cget('-undefstring') if (!defined $value);
    return sprintf($w->cget('-format'), $value);
}
1;
__END__

=head1 NAME
Tk::LabFrameFmt - Printf style formated labels.

=head1 SYNOPSIS

S<    >I<$lo> = I<$parent>-E<gt>B<LabFrameFmt>(I<-option> =E<gt> I<value>, ... );

=head1 DESCRIPTION

This widget is a standard Lable that contains an optional format string that can be set to 
format a label's textvariable.  Additionally a specific string can be supplied do display on
undef, and a callback can be supplied for more complicated formats.

=over 4

=item B<labeloptions>

LabFrameFmt takes all valid options of Tk::Label;

=item B<-format>

A sprintf style format string that textvariable with be displayed with.

=item B<-undefstring>

The value to display if textvariable is 'undef'.

=item B<-uds>

A alias for -undefstring.

=item B<-formatcmd>

Specifies a callback function to do formatting.  @_ = ($value, -format, -undefstring).

=back

=head1 METHODS

None.

=head1 ADVERTISED WIDGETS

None.

=head1 EXAMPLE

I<$lo> = I<$mw>-E<gt>B<LabFrameFmt>(-format =E<gt> "Errors (%d)",
                                    -undefstring =E<gt> "none",
                                    -textvariable =E<gt> \$numerrors
                                    );

=head AUTHOR

rviosca@imageman.com

This program is free software; you can redistribute it and/or modify it and/ormodify it 
under the same terms as Perl itself.

=head1 SEE ALSO

L<Tk::LabelFmt|Tk::LabelFmt>
L<Tk::LabelTimer|Tk::LabelTimer>
L<Tk::LabelWgs|Tk::LabelWgs>

=cut