Tcl-pTk
view release on metacpan or search on metacpan
lib/Tcl/pTk/TableMatrix/Spreadsheet.pm view on Meta::CPAN
-variable => $arrayVar,
-selectmode => 'extended',
-titlerows => 1,
-titlecols => 1,
-bg => 'white',
);
=head1 DESCRIPTION
L<Tcl::pTk::TableMatrix::Spreadsheet> is a L<Tcl::pTk::TableMatrix>-derived widget that implements
some bindings so the resulting widget behaves more like a spreadsheet.
B<Bindings Added:>
=over 1
=item *
Row/Col resize handles appear when the cursor is placed
over a row/col border line in the rol/col title area.
Dragging these handles will resize the row or column. If multiple rows or columns
are selected, then the new row/col size will apply to all row/cols selected.
Note: With the base Tk::TableMatrix, it is possible to resize the row/cols by dragging
on any cell border. To be more spreadsheet-like, Tk::TableMatrix::Spreadsheet defaults to enable row/col
resizing only thru the title row/col dragging. To override this default behavoir, set the -resizeborder option to
'both' at startup.
=item *
A popup menu for row/col insert/delete appears when the mouse is right-clicked in the
row/col title areas.
=item *
Cells activate (i.e. the contents become edit-able) only when the cell is double-clicked
or the F2 button is pressed. The default L<Tcl::pTk::TableMatrix> behavior is for the
cell to be activated when the cell is single-clicked.
=item *
The Escape key causes any changes made to a cell to be canceled and the current
selection cleared.
=item *
The return key causes the the current cell to move down.
=item *
The tab (or shift tab) key causes the current cell to be moved to the right (left).
=item *
The delete key will delete the current selection, if no cell is currently active.
=item *
The Mouse button 2 (middle button) paste from the PRIMARY. (Control-v pastes from the
clipboard).
=back
=head1 Additional Information
Widget methods, options, etc, are inherited from the L<Tcl::pTk::TableMatrix> widget. See its
docs for additional information.
=cut
use Carp;
use Tcl::pTk (qw/ Ev /);
use Tcl::pTk::TableMatrix;
use Tcl::pTk::Derived;
use base qw/ Tcl::pTk::Derived Tcl::pTk::TableMatrix/;
Tcl::pTk::Widget->Construct("Spreadsheet");
sub ClassInit{
my ($class,$mw) = @_;
$class->SUPER::ClassInit($mw);
# Bind our motion routine to change cursors for row/column resize
$mw->bind($class,'<Motion>',['GeneralMotion',$mw, Ev('x'), Ev('y')]);
# Over-ride default button release binding
# so a cell won't activate by just clicking
$mw->bind($class,'<ButtonRelease-1>',['Button1Release', $mw]);
# Edit (activate) a cell if it is double-clicked
# Or F2 is pressed
$mw->bind($class,'<Double-1>',
[sub
{
my $w = shift;
my ($x,$y) = @_;
if ($w->Exists)
{
$w->CancelRepeat;
$w->activate('@' . $x.",".$y);
}
}, Ev('x'), Ev('y')
]
);
$mw->bind($class,'<F2>',
[sub
{
my $w = shift;
my ($x,$y) = @_;
if ($w->Exists)
lib/Tcl/pTk/TableMatrix/Spreadsheet.pm view on Meta::CPAN
$mw->bind($class,'<Escape>',
sub
{
my $w = shift;
$w->reread; # undo any changes if editing a cell
my $upperLeft = $w->cget(-roworigin).",".$w->cget(-colorigin);
$w->activate($upperLeft);
$w->selectionClear('all');
}
);
# Make the return key enter and move down
$mw->bind($class,'<Return>',['MoveCell',1,0]);
$mw->bind($class,'<KP_Enter>',['MoveCell',1,0]);
# Make the tab key enter and move right
$mw->bind($class,'<Tab>',
sub{
my $w = shift;
$w->MoveCell(0,1);
Tcl::pTk->break;
}
);
$mw->bind($class,'<Shift-KP_Tab>',['MoveCell',0,-1]);
# Make the delete key delete the selection, if no active cell
$mw->bind($class,'<Delete>',
sub{
my $self = shift;
my $active;
# Get the current active cell, if one exists
eval { $active = $self->index('active'); };
$active = '' if( $@); # No Active cell found;
# No Active cell if it is set to the upper left column (esc key pressed)
my $upperLeft = $self->cget(-roworigin).",".$self->cget(-colorigin);
$active = '' if( $active eq $upperLeft); # No Active cell found;
if( $active eq ''){ # No Active Cell, delete the selection
eval
{
$self->curselection(undef);# Clear whatever is selected
$self->selectionClear();
}
}
else{ # There is a current active cell, perform delete in that
$self->deleteActive('insert');
}
}
);
# middle mouse button release pastes from PRIMARY (control v pastes from clipboard)
$mw->bind(
$class,
$mw->windowingsystem ne 'aqua' ? '<ButtonRelease-2>' : '<ButtonRelease-3>',
[sub
{
my $w = shift;
my ($x, $y) = @_;
$w->Paste($w->index('@' . $x.",".$y),'PRIMARY') unless ($Tcl::pTk::TableMatrix::tkPriv{'mouseMoved'});
}, Ev('x'), Ev('y')
]
);
# Make Left-Right arrow keys move cells around (like the parent class), but
# if we are editing a cell, make the edit-cursor move around
$mw->bind($class,'<Left>',
sub
{
my $w = shift;
# Check for an active cell (i.e. we are currently editing)
my $active = eval { $w->index('active'); };
if( $active && $active ne '0,0' ){
my $posn = $w->icursor;
$w->icursor($posn - 1);
}
else{
# Not editing a cell, just move the selected cell around
$w->MoveCell(0,-1);
}
}
);
$mw->bind($class,'<Right>',
sub
{
my $w = shift;
# Check for an active cell (i.e. we are currently editing)
my $active = eval { $w->index('active'); };
if( $active && $active ne '0,0' ){
my $posn = $w->icursor;
$w->icursor($posn + 1);
}
else{
# Not editing a cell, just move the selected cell around
$w->MoveCell(0,1);
}
}
);
};
sub Populate {
my ($cw, $args) = @_;
# Set Default Args:
$args->{-bg} = 'white' unless defined( $args->{-bg});
lib/Tcl/pTk/TableMatrix/Spreadsheet.pm view on Meta::CPAN
$active = '' if( $@); # No Active cell found;
# No Active cell if it is set to the upper left column (i.e. esc key pressed)
my $upperLeft = $w->cget(-roworigin).",".$w->cget(-colorigin);
$active = '' if( $active eq $upperLeft); # No Active cell found;
if( $active eq ''){ # no active cell found, see if there is a selection
my $anchor = eval{$w->index('anchor')};
unless( defined($anchor) ){
# print "Anchor not defined\n";
return;
}
$fromCell = $anchor;
}
else{
$fromCell = $active;
}
($r,$c) = split(',',$fromCell);
# my $currentCell = "$r,$c";
$cell = $w->index(($r += $x).",".($c += $y));
$w->activate($upperLeft) if( $active ne '');
$w->see($cell);
#print "calling beginSelect on $cell\n";
#$w->SUPER::BeginSelect($cell);
if ($w->cget('-selectmode') eq 'browse')
{
$w->selection('clear','all');
$w->selection('set',$cell);
}
elsif ($w->cget('-selectmode') eq 'extended')
{
$w->selection('clear','all');
$w->selection('set',$cell);
$w->selection('anchor',$cell);
$Tcl::pTk::TableMatrix::tkPriv{'tablePrev'} = $cell;
}
}
#############################################################
## Over-ridden Paste.
## This method performs pasting cells in a more Excel-like way:
## Paste Data will be pasted into the current selection anchor point
## if no current cell is active, otherwise it pastes starting at the active
## cell.
##
## If no current active cell, and no anchor point, does nothing.
sub Paste{
my $w = shift;
my $cell = shift || '';
my $source = shift || 'CLIPBOARD'; # Default is to paste from the clipboard
my $data;
# Check for active cell or anchor cell:
unless($cell){
my $active; # Current active cell
# Get the current active cell, if one exists
eval { $active = $w->index('active'); };
$active = '' if( $@); # No Active cell found;
# No Active cell if it is set to the upper left column (i.e. esc key pressed)
my $upperLeft = $w->cget(-roworigin).",".$w->cget(-colorigin);
$active = '' if( $active eq $upperLeft); # No Active cell found;
if( $active eq ''){ # no active cell found, see if there is a selection
$cell = $w->index('anchor');
return unless( $cell); # don't paste if no anchor point and no active
}
else{
$cell = $active;
}
}
eval{ $data = $w->SelectionGet(-selection => $source); }; return if($@);
$w->PasteHandler($cell,$data);
$w->focus if ($w->cget('-state') eq 'normal');
}
#############################################################
#
# Sub called when button 1 released.
# Takes care or row/col border drags.
# Also checks to see if more than one row/col is selected during
# a row/col resize, so those row/cols will be resized as well
sub Button1Release{
my $w = shift;
#print "Button Release 1\n";
if ( $w->{rowColResizeDrag} ) { # Row/Col resize finishing up
my @selRowCol = $w->curselection;
if ( $w->{rowColResizeRow} ) { # Row risize, check for other rows selected
my $row = $w->{rowColResizeRow};
my $newRowHeight = $w->rowHeight($row);
#print "Resized row $row to height" . $newRowHeight . "\n";
# Find other selected rows (must be contiguous selected from the drag row)
my $rowOrg = $w->cget( -roworigin );
my $colOrg = $w->cget( -colorigin );
my $rowMax = $rowOrg + $w->cget( -rows ) - 1; # max row in table
my $firstDataRow =
$rowOrg + $w->cget( -titlerows ); # first Data Row
my $firstDataCol =
( run in 2.079 seconds using v1.01-cache-2.11-cpan-2398b32b56e )