Tk-TableMatrix

 view release on metacpan or  search on metacpan

TableMatrix/Spreadsheet.pm  view on Meta::CPAN

    -width => 6, -height => 6,
    -titlerows => 1, -titlecols => 1,
    -variable => $arrayVar,
    -selectmode => 'extended',
    -bg => 'white',
  );

=head1 DESCRIPTION

L<Tk::TableMatrix::Spreadsheet> is a L<Tk::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<Tk::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<Tk::TableMatrix> widget. See its 
docs for additional information.

=cut



package Tk::TableMatrix::Spreadsheet;

use Carp;


use Tk;
use Tk::TableMatrix;
use Tk::Derived;

use base qw/ Tk::Derived Tk::TableMatrix/;

$VERSION = '1.29';


Tk::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]);

	# 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 $Ev = $w->XEvent;
		  if ($w->exists)
		   {
		    $w->CancelRepeat;
		    $w->activate('@' . $Ev->x.",".$Ev->y);
		   }
		 }
	);
	$mw->bind($class,'<F2>',
		sub
		 {
		  my $w = shift;
		  my $Ev = $w->XEvent;

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);
				Tk->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');
			}
		}
		
	);
	
	# Button2 release pastes from PRIMARY (control v pastes from clipboard
	 $mw->bind($class,'<ButtonRelease-2>',
		  sub
		   {
		    my $w = shift;
		    my $Ev = $w->XEvent;
		    $w->Paste($w->index('@' . $Ev->x.",".$Ev->y),'PRIMARY') unless ($Tk::TableMatrix::tkPriv{'mouseMoved'});
		   }
		 );


};


sub Populate {
    my ($cw, $args) = @_;
    
    # Set Default Args:
    $args->{-bg} = 'white' unless defined( $args->{-bg});
    
    $args->{-colstretchmode} = 'unset' unless defined( $args->{-colstretchmode});

    # Default behavior is to not allow cell resizing, just at the row/col titles (like Excel)
    $args->{-resizeborders}  = 'none' unless defined( $args->{-resizeborders});
    
    
    $cw->SUPER::Populate($args);
    
    # default Tags
    $cw->tagConfigure('active', -bg => 'gray90', -relief => 'sunken', -fg => 'black');
    $cw->tagConfigure( 'title', -bg => 'gray85', -fg => 'black', -relief => 'sunken');
   
   
    # setup Popup Menu (right mouse-button press) for common operations
    my $popup = $cw->Menu('-tearoff' => 0);
    $popup->command('-label' => 'Insert', -bg => 'gray85', '-command' => ['insertRowCol',$cw] );
    $popup->command('-label' => 'Delete', -bg => 'gray85','-command' => ['deleteRowCol',$cw] );
    $popup->command('-label' => 'Clear Contents', -bg => 'gray85','-command' => ['curselection', $cw,''] );
 
 
 
 
    # Bind a sub for button 3 press
    $cw->bind('<ButtonPress-3>', 

	sub {
	

	    	my $Ev = $cw->XEvent;

		# Don't Do anything if we are on a cell border
		#  This keeps the right-click menu from pop-ing up
		#  when starting a cell re-size
		my @border = $cw->border('mark',$Ev->x,$Ev->y);
		# print "border = ".join(", ",@border)." size = ".scalar(@stuff)."\n";
		
		# return if on a border or if not in edit mode
	        return if( scalar(@border) || ( $cw->cget(-state) =~ /disabled/i ));
		

		my $inTitleArea = 0;  # Flag = 1 if we are in a title Area

TableMatrix/Spreadsheet.pm  view on Meta::CPAN

	# 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
		my $anchor = $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);
	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);
	  $Tk::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;
    my $Ev = $w->XEvent;
    #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