view release on metacpan or  search on metacpan

alpha/Tk/ListMgr.pm  view on Meta::CPAN

package Tk::ListMgr;

use Tk qw(Ev);
use Tk::Cloth;
use Carp;
use strict;
use vars qw(@ISA $VERSION);

@ISA = qw(Tk::Derived Tk::Frame);
$VERSION = "0.02";

Construct Tk::Widget 'ListMgr';

*Tk::Widget::privateData = sub  {
    my $w = shift;
    my $p = shift || caller;
    $w->{$p} ||= {};
} unless defined &Tk::Widget::privateData;

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

    $mw->bind($class,"<1>",		['BeginSelect', Ev('index',Ev('@'))]);
    $mw->bind($class,"<Shift-1>",	['BeginExtend',Ev('index',Ev('@'))]);
    $mw->bind($class,"<Configure>" ,	['LayoutRequest', 1 ]);
    $mw->bind($class,"<FocusIn>" , 	['swapHighlight' ]);
    $mw->bind($class,"<FocusOut>" ,	['swapHighlight' ]);
}

sub swapHighlight {
    my $self = shift->Subwidget('cloth');
    $self->configure(
	-highlightbackground => $self->cget('-highlightcolor'),
	-highlightcolor => $self->cget('-highlightbackground'),
    );	
}

sub Populate {
    my $lmgr = shift;

    $lmgr->configure(
	-borderwidth => 0,
	-highlightthickness => 0
    );

    my $cloth = $lmgr->Cloth()->pack(
	-fill => 'both',
	-expand => 1
    );

    $lmgr->Advertise(cloth => $cloth);

    my $cb = [ 'ForwardEvent', Ev(['parent'])];

    foreach my $tag (qw(ButtonRelease ButtonPress KeyPress KeyRelease Motion)) {
	$cloth->bind(ref($cloth), "<Any-$tag>" , $cb);
    }
    $cloth->bindtags([ ref($cloth),$cloth->toplevel, 'all']);

    $lmgr->ConfigSpecs(
	DEFAULT => [$cloth],
	-layout => [METHOD => undef, undef, 'horizontal'],
	-takefocus => ["SELF", "takeFocus", "TakeFocus", 1],
	-background => [['SELF',$cloth],qw(background Background green)],
	-borderwidth => [$cloth, 'borderwidth','Borderwidth',2],
	-relief => [$cloth, 'relief','Relief','raised'],
	-highlightthickness => [$cloth, 'highlightThickness','HighlightThickness',0],
	-selectmode => [PASSIVE => undef, undef, 'single'],