view release on metacpan or  search on metacpan

lib/Tcl/pTk/TableMatrix.pm  view on Meta::CPAN

package Tcl::pTk::TableMatrix;

our ($VERSION) = ('1.11');

###########################################################
# Emulation of the perl/tk Tablematrix widget using Tcl::pTk
###########################################################

@Tcl::pTk::TableMatrix::ISA = (qw / Tcl::pTk::Derived Tcl::pTk::Widget/);

use strict;
use Tcl::pTk ('Ev');

use Carp;

Construct Tcl::pTk::Widget 'TableMatrix';

# Predeclare methods like 'borderMark', 'clearCache', so they don't have to be autoloaded
use Tcl::pTk::Submethods ( 'border'   => [qw(dragto)],
		     'clear'    => [qw(cache sizes tags all)],
		     'delete'   => [qw(active cols rows)],
		     'insert'   => [qw(active cols rows)],
		     'scan'     => [qw(mark dragto)],
		     'selection'=> [qw(anchor clear includes set)],
		     'tag'      => [qw(cell cget col configure delete exists
				     includes names row raise lower)],
		     'window'   => [qw(cget configure delete move names)],
		     'xview'  => [qw(moveto scroll)],
		     'yview'  => [qw(moveto scroll)],
			);


# Override classOkWidgets from Megawidget.pm because TableMatrix can accept the -class option
#  on widget creation, just like Frame and Toplevel widgets
sub classOkWidgets{
	my $package = shift;
	my @widgetList = $package->SUPER::classOkWidgets();
	return ('Tcl::pTk::TableMatrix', @widgetList);

}


# 
sub colWidth{
        my $self = shift;
        $self->interp->invoke($self, 'width', @_);
}
sub rowHeight{
        my $self = shift;
        $self->interp->invoke($self, 'height', @_);
}

# Special handling for borderMark to return a list
sub borderMark{
        my $self = shift;
        my @retVal = $self->interp->invoke($self, 'border', 'mark', @_ );
}

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

    $cw->SUPER::Populate( $args );
    
    # Create attributes:
    #   Name of the Tcl variable used to store the -variable data
    $cw->{varTclName} = "::perl:_variable".$cw;