#!/usr/local/bin/perl
#
# Status
#
# Class to provide a status bar
#
# Author: Jennifer Liddle (js10)
#
# $Id: Status.pm,v 1.2 2005/01/04 11:47:07 mca Exp $
#
# $Log: Status.pm,v $
# Revision 1.2  2005/01/04 11:47:07  mca
# bugfix: could not set foreground colour
#
# Revision 1.1  2004/12/09 13:57:39  mca
# move SITk/* (items in root of SITk cvs project) to
#      SITk/SITk/* (items in SITk perl namespace, in SITk cvs project)
# as agreed with rmd,js10
#
# Revision 1.1  2004/12/03 12:06:15  holroyd
# Moved to SITk/ namespace in the cvs repository from PSG/lib .
#
# Revision 1.3  2004/11/29 17:44:15  mca
# fix POD
#
# Revision 1.2  2004/11/29 17:38:50  mca
# Turn it into a tk widget, with POD and a small example
#
# Revision 1.1  2004/11/26 17:18:41  holroyd
# moved files within badger CVS,
#  from libs/Status.pm
#  to PSG/lib/SITk/Status.pm
#
# Revision 1.1.1.1  2004/10/06 14:12:41  js10
# Initial import
#
# Revision 1.1.1.1  2004/06/09 10:24:17  js10
# Initial work-in-progress version
#
#

package SITk::Status;


=head1 NAME

SITk::Status - minimal status bar

=head1 SYNOPSIS

  use SITk::Status;
  my $mw = MainWindow->new();
  $mw->Button(-text => "dull")->pack(-side => bottom);
  my $st = $mw->Status(-selfpack => 1); # guarantees to pack itself at the bottom
  $mw->Button(-text => "Don't click me", -command => sub {
    $st->error("Eeek!");
  })->pack;
  $st->show("Some text");

=head1 SEE ALSO

http://search.cpan.org/~zabel/Tk-StatusBar-0.04/lib/Tk/StatusBar.pm

=cut

use Tk;
use base qw(Tk::Derived Tk::Label);
Tk::Widget->Construct('Status');

sub Populate
{
	my $self = shift;
	my $args = shift;

	# Set default config item
	$args->{-relief} ||= 'raised';

	# Take a construction parameter
	my $do_pack = delete $args->{-selfpack};

	# Finish constructing the Label
	$self->SUPER::Populate($args);

	# No idea why the default for this is not adequate
	$self->ConfigSpecs(-foreground => [ 'SELF', 'Foreground', 'foreground', 'black']);

#	$self->{status} = $w->Label(-relief=>'raised')->pack(-fill=>'x', -side=>'bottom');
#	$self->{defaultBackground} = $self->{status}->configure(-background);
#	$self->{defaultForeground} = $self->{status}->configure(-foreground);

	if ($do_pack) {
	    $self->pack(-fill => 'x', -side => 'bottom');
	    my %packing = $self->packInfo;
	    my $master = $packing{-in};
	    my @slaves = $master->packSlaves;
	    $self->pack(-before => $slaves[0]); # take first bite of the bottom row
	}

	return $self;
}

sub show
{
	my $self = shift;
	$self->configure(-text=>shift,
			 -background=>'grey85', 
			 -foreground=>'black');
}

sub error
{
	my $self = shift;
	my $txt = shift;
	chomp($txt);
	$self->configure(-text=>$txt, -background=>'red', -foreground=>'yellow');
	$self->bell();
}


1;
