File Coverage

blib/lib/Tk/FileEntry.pm

Criterion	Covered	Total	%
statement	6	44	13.6
branch	0	10	0.0
condition	0	6	0.0
subroutine	2	8	25.0
pod			n/a
total	8	68	11.7

## $Source: FileEntry.pm $ $Revision: 1.4 $
###
### Primitive FileEntry widget. POD after __END__

package Tk::FileEntry;
use strict;

sub printargs {
    print join('|', map { $_ = '(undef)' unless defined $_ } @_, "\n");
}

require Tk;
require Tk::Widget;
require Tk::Derived;
require Tk::Frame;

use vars qw($VERSION @ISA);
@ISA = qw(Tk::Derived Tk::Frame);
$VERSION = substr q$Revision: 1.4 $, 10;

Construct Tk::Widget 'FileEntry';

my $FILEBITMAP = undef;

sub ClassInit {
    my ($class, $mw) = @_;

    return if defined $FILEBITMAP;  # needed for several MainWindows
    $FILEBITMAP = __PACKAGE__ . '::OPENFOLDER';

    my $bits = pack("b16"x10,
        "...111111.......",
        "..1......11.....",
        ".1.........1....",
        ".1..........1...",
        ".1...11111111111",
        ".1..1.1.1.1.1.1.",
        ".1.1.1.1.1.1.1..",
        ".11.1.1.1.1.1...",
        ".1.1.1.1.1.1....",
        ".1111111111.....",
        );

    $mw->DefineBitmap($FILEBITMAP => 16,10, $bits);

}

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

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

    require Tk::Label;
    require Tk::Entry;
    require Tk::Button;

    my $l = $w->Label()->pack(-side=>'left');
    my $e = $w->Entry()->pack(-side=>'left', -expand=>'yes', -fill=>'x');
    my $b = $w->Button(-command=>[\&_selectfile, $w, $e],-takefocus=>0)
		->pack(-side=>'left',-fill=>'y');

    $e->bind('', [$w, '_invoke_command', $e]);

    $w->Advertise('entry' => $e);
    $w->Advertise('button' => $b);

    $w->ConfigSpecs(

	    -background	=> [qw(CHILDREN background Background), Tk::NORMAL_BG()],
	    -foreground	=> [qw(CHILDREN foreground Foreground), Tk::BLACK()    ],
	    -state 	=> [qw(CHILDREN state      State        normal)        ],
	    -label       => [{-text => $l},   'label',      'Label',     'File:'],
	    -filebitmap  => [{-bitmap => $b}, 'fileBitmap', 'FileBitmap', $FILEBITMAP,],
	    -command	 => ['CALLBACK',       undef,        undef,       undef],
	    -variable    => ['METHOD',         undef,        undef,       undef],
	    );
    $w;
}


sub _selectfile {
    my $w = shift;
    my $e = shift;

    unless (defined $w->{FSBOX}) {
	require Tk::FileSelect;
	$w->{FSBOX} = $w->FileSelect(); #-directory => '.');
    }
    my $file = $w->{FSBOX}->Show();

    return unless defined $file && length $file;
    $e->delete(0,'end');
    $e->insert('end',$file);
    $w->Callback(-command => $w, $file);
}

sub _invoke_command {
    my $w = shift;
    my $e = shift;
    my $file = $e->get();
    return unless defined $file && length $file;
    $w->Callback(-command => $w, $e->get);
}

sub variable {
    my $e = shift->Subwidget('entry');
    my $v = shift;
    $e->configure(-textvariable => $v);
}

1;

__END__