File Coverage

blib/lib/Tk/StatusBar.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package Tk::StatusBar;

use warnings;
use strict;

use base qw(Tk::Frame);

use Tk::widgets qw(Frame Label ProgressBar);
use Carp;

Construct Tk::Widget 'StatusBar';

use vars qw($VERSION);
$VERSION = 0.04;


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

    my $ResizeButtonImage = << 'end-of-pixmap';
/* XPM */
static char * Icon_xpm[] = {
"13 14 3 1",
"    c none",
"X   c #888888",
"A   c #FFFFFF",
"             ",
"             ",
"            A",
"           AX",
"          AXX",
"         AXX ",
"        AXX A",
"       AXX AX",
"      AXX AXX",
"     AXX AXX ",
"    AXX AXX A",
"   AXX AXX AX",
"  AXX AXX AXX",
" AXX AXX AXX ",
};
end-of-pixmap

    $mw->Pixmap('ResizeButtonImage', -data => $ResizeButtonImage);
}

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

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

    # add a spacer frame
    $self->Frame()->pack(-pady => 1);

    # add the resize button
    $self->{ResizeButton} = $self->Label(
        -image      => 'ResizeButtonImage',
        -relief     => 'flat',
        -cursor     => ($^O =~ /^(MSWin32|DOS)$/ ? 'size_nw_se' : 'bottom_right_corner'),
    )->pack(
        -side   => 'right',
        -anchor => 'se',
    );

    # bind events to the resize button
    $self->{ResizeButton}->bind("", [\&_Mark, $self]);
    $self->{ResizeButton}->bind('' => [\&_Resize, $self]);

    # hidden until show() is called
    $self->{HIDDEN} = 1;

    # now show the statusbar
    $self->show();
}

sub _Mark {
    $_[1]->{markx} = $_[1]->pointerx;
    $_[1]->{marky} = $_[1]->pointery;
}

sub _Resize {
    my $self = $_[1];
    my ($w, $h) = split /[x+]/, $self->parent->geometry;
    $w += ($self->pointerx - $self->{markx});
    $h += ($self->pointery - $self->{marky});
    $self->_Mark($self);
    $self->parent->geometry($w . 'x' . $h)  if ($w > 0 && $h > 0);
}

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

    my $width           = delete $args{-width};
    my $side            = delete $args{-side}           || 'left';
    my $relief          = delete $args{-relief}         || 'sunken';
    my $borderwidth     = delete $args{-borderwidth}    || 1;
    my $anchor          = delete $args{-anchor}         || 'w';
    my $expand          = delete $args{-expand}         || 1;
    my $command         = delete $args{-command};
    my $event           = delete $args{-event}          || '';

    if ($command && ref($command) ne 'CODE') {
        croak "-command must be a code reference";
    }

    my $n = $self->Label(
        -relief         => $relief,
        -borderwidth    => $borderwidth,
        -anchor         => $anchor,
        %args,
    );

    if (! $width) {
        $n->pack(
            -side       => $side,
            -expand     => $expand,
            -fill       => 'x',
            -padx       => 1,
        );
    }
    else {
        $n->configure(-width => $width);
        $n->pack(
            -side       => $side,
            -padx       => 1,
        );
    }

    if ($command && $event) {
        eval {$n->bind($event, $command)};
        croak "bad event type, keysym, or command" if $@;
    }

    return $n;
}

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

    my $length          = $args{-length};
    my $borderwidth     = delete $args{-borderwidth}        || 1;
    my $expand          = delete $args{-expand}             || 1;
    my $relief          = delete $args{-borderwidth}        || 'sunken';
    my $side            = delete $args{-side}               || 'left';

    my $n = $self->ProgressBar(
        -borderwidth    => $borderwidth,
        -width          => 17,
        -troughcolor    => 'systembuttonface',
        %args,
    );

    $n->configure(-length => $length)  if $length;

    if (! $length) {
        $n->pack(
            -side       => $side,
            -expand     => $expand,
            -fill       => 'x',
            -padx       => 1,
        );
    }
    else {
        $n->pack(
            -side       => $side,
            -padx       => 1,
        );
    }

    return $n;
}

sub hide {
    my $self = shift;
    if (! $self->{HIDDEN}) {
        $self->packForget;
        $self->{HIDDEN} = 1;
    }
}

sub show {
    my $self = shift;
    if ($self->{HIDDEN}) {
        my %args = (
            -side       => 'bottom',
            -fill       => 'x',
        );

        if ($self->parent->packSlaves) {
            ($args{-before}) = $self->parent->packSlaves;
        }

        $self->pack(%args);
        $self->{HIDDEN} = 0;
    }
}



1;
__END__