view release on metacpan or  search on metacpan

lib/Tk/TM/wgTable.pm  view on Meta::CPAN

#!perl -w
#
# Tk Transaction Manager.
# Table data widget. To use with data object.
#
# makarow, demed
#

package Tk::TM::wgTable;
require 5.000;
use strict;
use Tk;
use Tk::TM::Common;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = '0.53';
@ISA = ('Tk::Derived','Tk::Frame');

Tk::Widget->Construct('tmTable'); 

#######################
sub Populate {
 my ($self, $args) = @_;
 my $mw =$self->parent;

 # print "********Populate/Initing...\n";
 $self->initialize();
 foreach my $opt ($self->set()) {
   if (exists($args->{$opt})) {
      $self->set($opt=>$args->{$opt});
      delete($args->{$opt});
   }
 }
 $self->configure(-borderwidth=>2,-relief=>'groove');
 $self->ConfigSpecs(-font=>['DESCENDANTS']);
 $self->ConfigSpecs(-relief=>['CHILDREN']);
 $self->ConfigSpecs(-background=>['CHILDREN']);
 $self->ConfigSpecs(-foreground=>['CHILDREN']);

 # print "********Populate/Populating...\n";
 $self->Remake();
 $self
}

#######################
sub initialize {
 my $self = shift;
 my $mw   =$self->parent;
 $self->{-do}       =undef; # transaction manager            # configurable
 $self->{-colspecs} =[];    # widgetSpec =$self->[$col]      # configurable
 $self->{-rowcount} =8;     # count of rows                  # configurable
 $self->{-wgscroll} =undef; # scrollbar
 $self->{-widgets}  =[];    # widget =$self->[$row]->[$col]
}

#######################
sub set {
 return(keys(%{$_[0]})) if scalar(@_) ==1;
 return($_[0]->{$_[1]}) if scalar(@_) ==2;
 my ($self, %opt) =@_;
 foreach my $k (keys(%opt)) {
  $self->{$k} =$opt{$k};
 }
 if ($opt{-do} || ($self->{-do} && $opt{-widgets})) {
    # print "****bindings****\n";
    my $row =-1;
    foreach my $wgrow (@{$self->{-widgets}}) {
      $row++;
      my $col =-1;
      foreach my $wg (@$wgrow) {
        $col++;
        next if !$wg || ref($wg) eq 'Tk::Label';
        my $tv;
        $wg->configure(-textvariable=>\$tv);
        my ($row1, $col1) =($row, $col);
        $wg->bind('<Up>'          ,sub{$self->{-do}->RowGo('prev')});
        $wg->bind('<Down>'        ,sub{$self->{-do}->RowGo('next')});