<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">=head1 NAME

Tk::TableMatrix::SpreadsheetHideRows - Table Display with selectable hide/un-hide of rows

=head1 SYNOPSIS

  use Tk;
  use Tk::TableMatrix::SpreadsheetHideRows



  my $t = $top-&gt;Scrolled('SpreadsheetHideRows', 
  			      -selectorCol =&gt; 3,
			      -expandData =&gt; $hashRef,
			      -rows =&gt; 21, -cols =&gt; 11, 
                              -width =&gt; 6, -height =&gt; 6,
			      -titlerows =&gt; 1, -titlecols =&gt; 1,
			      -variable =&gt; $arrayVar,
			      -selectmode =&gt; 'extended',
			      -resizeborders =&gt; 'both',
			      -titlerows =&gt; 1,
			      -titlecols =&gt; 1,
			      -bg =&gt; 'white',
                    );

=head1 DESCRIPTION

L&lt;Tk::TableMatrix::SpreadsheetHideRows&gt; is a L&lt;Tk::TableMatrix::Spreadsheet&gt;-derived widget that implements
a Spreadsheet-like display of tabular information, where some of the rows in the table
can be expanded/hidden by clicking a '+/-' selector in the row. This can be used to display
top-level information in a table, while allowing the user to expand certain table rows to 
view detail-level information. 

See demos/SpreadsheetHideRows in the source distribution for a simple example of this widget

=head1 Widget-specific Options 

In addition the standard L&lt;Tk::TableMatrix&gt; widget options. The following options are implemented:

=over 1

=item  -selectorCol

Column number where the +/- selector will appear. Clicking on the +/- selector
will expand/hide the detail information in the table for a particular row.

=item  -selectorColWidth

Width of the column used to display the +/- selector. Defaults to 2

=item -expandData

Hash ref defining the detail-level data displayed when a row is expanded (by clicking
the +/- selector). This hash ref should have the following structure:

  $expandData = {  
  	row1 =&gt; {  tag  =&gt; 'detailDataTag',
	           data =&gt; $detailData,
		   spans=&gt; $spanData,
		   expandData =&gt; $subLevelData
		},
	row2 =&gt; { 
	   .
	   .
  }
  
  Where: 
    row1, row2, ... 	    Row numbers that will be expandable.
    tag =&gt; 'detailDataTag'  Tag name that will be applied to the detail data.
    			    (optional)
    $detailData              2D Array of detail-data to be displayed when 
    			     the row is expanded.
			     e.g. [ [ r1c1, r1c2, r1c3 ],
			            [ r2c1, r2c2, r2,c3] ]
    $spans                   1D array of span information (optional) to be 
    			     used for display of the detail information.
			     e.g.  [ col2 =&gt;  "rows,cols", col4 =&gt;  "rows,cols", ... ]

    $subLevelData            Optional Recursive expandData used to hold detail-data of detail-data.



=back

=head1 MEMBER DATA

The following items are stored as member data

=over 1

=item defaultCursor

Name of the mouse cursor pointer that is used for normal (i.e. non-title, non-indicator) cells in the widget. 
This is set to the value of the $widget-&gt;cget(-cursor) option when the widget is created. 

=item indRowCols

Hash ref of Row/Cols indexes where there are indicators stores. This is a quick
lookup hash built from I&lt;_expandData&gt;.

=item _expandData

Internal version of the I&lt;expandData&gt; hash. Any sub-detail data (i.e. expand data 
that is at lower levels of I&lt;ColexpandData&gt;) that is visible is placed at the top level of this hash, for
keeping track of the visible I&lt;expandData&gt;.

=back

=head1 Widget Methods 

In addition the standard L&lt;Tk::TableMatrix&gt; widget method. The following methods are implemented:


=cut

package Tk::TableMatrix::SpreadsheetHideRows;

use Carp;


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

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

$VERSION = '1.24';


Tk::Widget-&gt;Construct("SpreadsheetHideRows");


sub ClassInit{
	my ($class,$mw) = @_;

	$class-&gt;SUPER::ClassInit($mw);
	
	

};


sub Populate {
    my ($self, $args) = @_;
    
    $self-&gt;ConfigSpecs(
       -selectorCol     =&gt; 	[qw/METHOD selectorCol     SelectorCol/,    undef],
       -selectorColWidth=&gt; 	[qw/PASSIVE selectorColWidth     SelectorColWidth/,    2],
       -expandData      =&gt; 	[qw/METHOD expandData     ExpandData/,    {}],
       -selectorRow     =&gt; 	[qw/METHOD selectorRow     SelectorRow/,    undef],
       -selectorRowWidth=&gt; 	[qw/PASSIVE selectorRowWidth     SelectorRowWidth/,    2],
       -expandDataCol      =&gt; 	[qw/METHOD expandDataCol     ExpandDataCol/,    {}],
   );

    
    $self-&gt;SUPER::Populate($args);
    
    $self-&gt;tagConfigure('plus', -image =&gt;  $self-&gt;Getimage("plus"), -showtext =&gt; 0, -anchor =&gt; 'center');
    $self-&gt;tagConfigure('minus', -image =&gt;  $self-&gt;Getimage("minus"), -showtext =&gt; 0,  -anchor =&gt; 'center');
    
    $self-&gt;{normalCursor} = $self-&gt;cget('-cursor'); # get the default cursor
 
 
}

=head2 showDetail

Shows (i.e. expands the table) the detail data for a given row. This method is called
when a user clicks on an indicator that is not already expanded.

B&lt;Usage:&gt;

 $widget-&gt;showDetail($row);  
 
 # Shows the detail data for row number $row

=cut

sub showDetail{

	my $self = shift;
	
	my $row = shift;
	
	my $selectorCol = $self-&gt;cget(-selectorCol);
	
	my $index = "$row,$selectorCol"; # make index for the cell to be expanded
	
	my $indRowCols = $self-&gt;{indRowCols};
	
	$self-&gt;tagCell('minus', $index);
	$indRowCols-&gt;{$index} = '-';
	
	# Get the detail data and insert:
	my $expandData = $self-&gt;{'_expandData'};
	my $detailData = $expandData-&gt;{$row};
	my $detailArray = $detailData-&gt;{data};
	
	my $noRows = scalar( @$detailArray);
	
	# InsertRows:
	#    change state to normal if not already so we can insert
	my $currentState = $self-&gt;cget(-state); 
	$self-&gt;configure(-state =&gt; 'normal') unless( $currentState eq 'normal');
	$self-&gt;insertRows($row,$noRows);
	
	# Adjust Spans:
	$self-&gt;adjustSpans($row+1,$noRows);
	
	#insert data
	my $colorigin =  $self-&gt;cget(-colorigin);
	my $rowNum = $row+1;
	foreach my $rowData( @$detailArray ){
		#my @rowArray = @$rowData; 
		#grep s/([\{\}])/\\$1/g, @rowArray; # backslash any existing '{' chars, so they don't get interpreted as field chars
		my $insertData = "{".join("}{", @$rowData)."}"; # make insert data look like tcl array, so it
								# gets put in different cells
		$self-&gt;set('row', "$rowNum,$colorigin", $insertData);
		$rowNum++;
	}
	
	# Apply Tags, if any:
	my $tag;
	if( defined( $detailData-&gt;{tag})){
		$tag = $detailData-&gt;{tag};
		my $startRow = $row+1;
		my $noRows = @$detailArray;
		my $stopRow = scalar(@$detailArray) + $startRow - 1;
		my @tagRows = ($startRow..$stopRow);
		$self-&gt;tagRow($tag,@tagRows);
	}

	# Apply Spans, if any:
	my $spans;
	if( defined( $detailData-&gt;{spans})){
		$spans = $detailData-&gt;{spans};
		
		my $spanSize = scalar(@$spans);
		#Error Checking, spans array should be a multiple of 2
		if( ($spanSize % 2) &lt; 1){
		
			my $startRow = $row+1;
			my $noRows = @$detailArray;
			my $stopRow = scalar(@$detailArray) + $startRow - 1;
			foreach my $spanRow($startRow..$stopRow){
				# build an array to feed to spans, change column number for row.col index
				#   (every 2rd item in the array).
				my @spanArray = map $_ % 2 ? $spans-&gt;[$_] : "$spanRow,".$spans-&gt;[$_], (0..($spanSize-1));
				$self-&gt;spans(@spanArray);
			}
			
		}else{
			warn("Spans array for row $row, is not a multiple of 2\n");
		}
			
	}

	
	
	
	# Now Update the internal arrays for the inserted rows ###
	my %expandDataNew;
	foreach my $rowIndex(keys %$expandData){
		if($rowIndex &gt; $row){ # adjust rows greater than the current row
			$expandDataNew{$rowIndex+$noRows} = $expandData-&gt;{$rowIndex};
		}
		else{
			$expandDataNew{$rowIndex} = $expandData-&gt;{$rowIndex};
		}
	}
	# Copy new to existing:
	%$expandData = %expandDataNew;
	
	
	my %indRowColsNew;
	foreach my $rcindex(keys %$indRowCols){
		
		my ($rowIndex,$colIndex) = split(',',$rcindex);
		if($rowIndex &gt; $row){ # adjust rows greater than the current row
			my $newRow = $rowIndex+$noRows;
			$indRowColsNew{"$newRow,$colIndex"} = $indRowCols-&gt;{$rcindex};
		}
		else{
			$indRowColsNew{$rcindex} = $indRowCols-&gt;{$rcindex};
		}
	}
	# Copy new to existing:
	%$indRowCols = %indRowColsNew;
	
	# Take care of any lower-level detail data:
	my $subDetail;
	if( defined( $detailData-&gt;{expandData})){
		$subDetail = $detailData-&gt;{expandData};
		
		foreach my $subRow( keys %$subDetail){
			
			my $realRow = $row+$subRow;
			my $index = "$realRow,$selectorCol";
			$self-&gt;tagCell('plus', $index);
			$indRowCols-&gt;{$index} = '+'; # update internal array
			
			# put subdetail data to top level, adjusting the relative row
			# numbers to real row numbers:
			#my %adjustedSubDetail;
			#foreach my $subKey(keys %$subDetail){
			#	$adjustedSubDetail{$subKey+$row} = $subDetail-&gt;{$subKey};
			#}
			$expandData-&gt;{$realRow} = $subDetail-&gt;{$subRow}; 
		}

	}

	# Put the state back
	$self-&gt;configure(-state =&gt; $currentState) unless( $currentState eq 'normal');
	
	
}

sub showDetailCol
{

    my $self = shift;

    my $col = shift;

    my $selectorRow = $self-&gt;cget(-selectorRow);

    my $index = "$selectorRow,$col"; # make index for the cell to be expanded

        my $indRowCols = $self-&gt;{indRowCols};

    $self-&gt;tagCell('minus', $index);
    $indRowCols-&gt;{$index} = '-';

# Get the detail data and insert:
    my $expandData = $self-&gt;{'_expandDataCol'};
    my $detailData = $expandData-&gt;{$col};
    my $detailArray = $detailData-&gt;{data};


    my $noCols = scalar( @$detailArray);

# InsertCols:
#    change state to normal if not already so we can insert
    my $currentState = $self-&gt;cget(-state); 
    $self-&gt;configure(-state =&gt; 'normal') unless( $currentState eq 'normal');
    $self-&gt;insertCols($col,$noCols);

# Adjust Spans:
    $self-&gt;adjustSpansCol($col+1,$noCols);

#insert data
    my $colorigin =  $self-&gt;cget(-colorigin);
    my $colNum = $col+1;
    foreach my $colData( @$detailArray ){
#my @ColArray = @$ColData; 
#grep s/([\{\}])/\\$1/g, @ColArray; # backslash any existing '{' chars, so they don't get interpreted as field chars
        my $insertData = "{".join("}{", @$colData)."}"; # make insert data look like tcl array, so it
# gets put in different cells
            $self-&gt;set('col', "$colorigin,$colNum", $insertData);
        $colNum++;
    }

# Apply Tags, if any:
    my $tag;
    if( defined( $detailData-&gt;{tag})){
        $tag = $detailData-&gt;{tag};
        my $startCol = $col+1;
        my $noCols = @$detailArray;
        my $stopCol = scalar(@$detailArray) + $startCol - 1;
        my @tagCols = ($startCol..$stopCol);
        $self-&gt;tagCol($tag,@tagCols);
    }

# Apply Spans, if any:
    my $spans;
    if( defined( $detailData-&gt;{spans})){
        $spans = $detailData-&gt;{spans};

        my $spanSize = scalar(@$spans);
#Error Checking, spans array should be a multiple of 2
        if( ($spanSize % 2) &lt; 1){

            my $startCol = $col+1;
            my $noCols = @$detailArray;
            my $stopCol = scalar(@$detailArray) + $startCol - 1;
            foreach my $spanCol($startCol..$stopCol){
# build an array to feed to spans, change column number for row.col index
#   (every 2rd item in the array).
                my @spanArray = map $_ % 2 ? $spans-&gt;[$_] : "$spanCol,".$spans-&gt;[$_], (0..($spanSize-1));
                $self-&gt;spans(@spanArray);
            }

        }else{
            warn("Spans array for Col $col, is not a multiple of 2\n");
        }

    }




# Now Update the internal arrays for the inserted cols ###
    my %expandDataNew;
    foreach my $colIndex(keys %$expandData){
        if($colIndex &gt; $col){ # adjust cols greater than the current col
            $expandDataNew{$colIndex+$noCols} = $expandData-&gt;{$colIndex};
        }
        else{
            $expandDataNew{$colIndex} = $expandData-&gt;{$colIndex};
        }
    }
# Copy new to existing:
    %$expandData = %expandDataNew;


    my %indRowColsNew;
    foreach my $rcindex(keys %$indRowCols){

        my ($rowIndex,$colIndex) = split(',',$rcindex);
        if($colIndex &gt; $col){ # adjust cols greater than the current col
            my $newCol = $colIndex+$noCols;
            $indRowColsNew{"$rowIndex,$newCol"} = $indRowCols-&gt;{$rcindex};
        }
        else{
            $indRowColsNew{$rcindex} = $indRowCols-&gt;{$rcindex};
        }
    }
# Copy new to existing:
    %$indRowCols = %indRowColsNew;

# Take care of any lower-level detail data:
    my $subDetail;
    if( defined( $detailData-&gt;{expandDataCol})){
        $subDetail = $detailData-&gt;{expandDataCol};

        foreach my $subCol( keys %$subDetail){

            my $realCol = $col+$subCol;
            my $index = "$selectorRow,$realCol";
            $self-&gt;tagCell('plus', $index);
            $indRowCols-&gt;{$index} = '+'; # update internal array

# put subdetail data to top level, adjusting the relative row
# numbers to real row numbers:
#my %adjustedSubDetail;
#foreach my $subKey(keys %$subDetail){
#	$adjustedSubDetail{$subKey+$row} = $subDetail-&gt;{$subKey};
#}
                $expandData-&gt;{$realCol} = $subDetail-&gt;{$subCol}; 
        }

    }

# Put the state back
    $self-&gt;configure(-state =&gt; $currentState) unless( $currentState eq 'normal');


}
=head2 hideDetail

Hides the detail data for a given row. This method is called
when a user clicks on an indicator that is already expanded.

B&lt;Usage:&gt;

 $widget-&gt;hideDetail($row);  
 
 # Hides the detail data for row number $row

=cut

sub hideDetail{

	my $self = shift;
	
	my $row = shift;
	my $expandData = shift;
	my $detailData = $expandData-&gt;{$row};

	my $selectorCol = $self-&gt;cget(-selectorCol);
	
	my $index = "$row,$selectorCol"; # make index for the cell to be hidden
	
	my $indRowCols = $self-&gt;{indRowCols};

	# hide any sublevel data first:
	my $lowerLevelHideRows = 0;
	if( defined( $detailData-&gt;{expandData})){ # sublevel data exists
		my $subLevelData = $detailData-&gt;{expandData};
		# convert sublevel data to absolute rows
		my $convertedSubData = {};
		foreach my $rowNum(keys %$subLevelData){
			$convertedSubData-&gt;{$rowNum+$row} = $subLevelData-&gt;{$rowNum};
		}
		#Hide lower level data, if showing
		my $subLevelIndex;
		foreach my $rowNum (sort {$a&lt;=&gt;$b} keys %$convertedSubData){
			$subLevelIndex = "$rowNum,$selectorCol";
			if( $indRowCols-&gt;{$subLevelIndex} eq '-'){
				# For lower-level hide-detail calls, we don't use any updates to the
				#   expandData Arg, so we create an anonymous hash ref in this call
				$lowerLevelHideRows += $self-&gt;hideDetail($rowNum,{ %$convertedSubData} );
			}
		}
	}
				
	
	$self-&gt;tagCell('plus', $index);
	$indRowCols-&gt;{$index} = '+';
	
	
	# Get the detail data and hide:
	my $detailArray = $detailData-&gt;{data};
	
	my $noRows = scalar( @$detailArray);

	# unapply any spans (This is not auto-handled by the row delete command, so we
	#  have to do it here manually)
	my $spans;
	if( defined( $detailData-&gt;{spans})){
		$spans = $detailData-&gt;{spans};
		
		my $spanSize = scalar(@$spans);
		#Error Checking, spans array should be a multiple of 2
		if( ($spanSize % 2) &lt; 1){
		
			my $startRow = $row+1;
			my $noRows = @$detailArray;
			my $stopRow = scalar(@$detailArray) + $startRow - 1;
			foreach my $spanRow($startRow..$stopRow){
				# build an array to feed to spans, change column number for row.col index
				#   (every 2rd item in the array).
				my @spanArray = map $_ % 2 ? '0,0' : "$spanRow,".$spans-&gt;[$_], (0..($spanSize-1));
				$self-&gt;spans(@spanArray);
			}
			
		}else{
			warn("Spans array for row $row, is not a multiple of 2\n");
		}
			
	}


	#    change state to normal if not already so we can modify the table
	my $currentState = $self-&gt;cget(-state); 
	$self-&gt;configure(-state =&gt; 'normal') unless( $currentState eq 'normal');

	# Move Any existing spans that are at rows &gt; $row+$noRows to where the should be, now that rows
	#  have been deleted
	$self-&gt;adjustSpans($row+$noRows,-$noRows);

	# deleteRows:
	$self-&gt;deleteRows($row+1,$noRows);

	my %indRowColsNew;
	foreach my $rcindex(keys %$indRowCols){
		
		my ($rowIndex,$colIndex) = split(',',$rcindex);
		if($rowIndex &gt; $row){ # adjust rows greater than the current row
			my $newRow = $rowIndex-$noRows;
			$indRowColsNew{"$newRow,$colIndex"} = $indRowCols-&gt;{$rcindex};
		}
		else{
			$indRowColsNew{$rcindex} = $indRowCols-&gt;{$rcindex};
		}
	}
	# Copy new to existing:
	%$indRowCols = %indRowColsNew;	
	
	
	$noRows += $lowerLevelHideRows; # Include the lower level detail rows hidden in the internall array update


	# Now Update the internal arrays for the deleted rows ###
	my %expandDataNew;
	foreach my $rowIndex(keys %$expandData){
		if($rowIndex &gt; ($row+$noRows)){ # adjust rows greater than the current row + detail data
			$expandDataNew{$rowIndex-$noRows} = $expandData-&gt;{$rowIndex};
		}
		elsif($rowIndex&lt;= $row){ # rows less than or equal just get copied
			$expandDataNew{$rowIndex} = $expandData-&gt;{$rowIndex};
		}
		#else nothing, expand data that is in the detail data that is being hidden doesn't get copied
	}
	# Copy new to existing:
	%$expandData = %expandDataNew;
		

	# Put the state back
	$self-&gt;configure(-state =&gt; $currentState) unless( $currentState eq 'normal');


	return $noRows;


}

sub hideDetailCol
{

	my $self = shift;
	
	my $col = shift;
	my $expandData = shift;
	my $detailData = $expandData-&gt;{$col};

	my $selectorRow = $self-&gt;cget(-selectorRow);
	
	my $index = "$selectorRow,$col"; # make index for the cell to be hidden
	
	my $indRowCols = $self-&gt;{indRowCols};

	# hide any sublevel data first:
	my $lowerLevelHideCols = 0;
	if( defined( $detailData-&gt;{expandDataCol})){ # sublevel data exists
		my $subLevelData = $detailData-&gt;{expandDataCol};
		# convert sublevel data to absolute rows
		my $convertedSubData = {};
		foreach my $colNum(keys %$subLevelData){
			$convertedSubData-&gt;{$colNum+$col} = $subLevelData-&gt;{$colNum};
		}
		#Hide lower level data, if showing
		my $subLevelIndex;
		foreach my $colNum (sort {$a&lt;=&gt;$b} keys %$convertedSubData){
			$subLevelIndex = "$selectorRow,$colNum";
			if( $indRowCols-&gt;{$subLevelIndex} eq '-'){
				# For lower-level hide-detail calls, we don't use any updates to the
				#   expandData Arg, so we create an anonymous hash ref in this call
				$lowerLevelHideCols += $self-&gt;hideDetailCol($colNum,{ %$convertedSubData} );
			}
		}
	}
				
	
	$self-&gt;tagCell('plus', $index);
	$indRowCols-&gt;{$index} = '+';
	
	
	# Get the detail data and hide:
	my $detailArray = $detailData-&gt;{data};
	
	my $noCols = scalar( @$detailArray);

	# unapply any spans (This is not auto-handled by the row delete command, so we
	#  have to do it here manually)
	my $spans;
	if( defined( $detailData-&gt;{spans})){
		$spans = $detailData-&gt;{spans};
		
		my $spanSize = scalar(@$spans);
		#Error Checking, spans array should be a multiple of 2
		if( ($spanSize % 2) &lt; 1){
		
			my $startCol = $Col+1;
			my $noCols = @$detailArray;
			my $stopCol = scalar(@$detailArray) + $startCol - 1;
			foreach my $spanCol($startCol..$stopCol){
				# build an array to feed to spans, change column number for row.col index
				#   (every 2rd item in the array).
				my @spanArray = map $_ % 2 ? '0,0' : "$spanCol,".$spans-&gt;[$_], (0..($spanSize-1));
				$self-&gt;spans(@spanArray);
			}
			
		}else{
			warn("Spans array for row $col, is not a multiple of 2\n");
		}
			
	}


	#    change state to normal if not already so we can modify the table
	my $currentState = $self-&gt;cget(-state); 
	$self-&gt;configure(-state =&gt; 'normal') unless( $currentState eq 'normal');

	# Move Any existing spans that are at rows &gt; $row+$noRows to where the should be, now that rows
	#  have been deleted
	$self-&gt;adjustSpansCol($col+$noCols,-$noCols);

	# deleteRows:
	$self-&gt;deleteCols($col+1,$noCols);

	my %indRowColsNew;
	foreach my $rcindex(keys %$indRowCols){
		
		my ($rowIndex,$colIndex) = split(',',$rcindex);
		if($colIndex &gt; $col){ # adjust rows greater than the current row
			my $newCol = $colIndex-$noCols;
			$indRowColsNew{"$rowIndex,$newCol"} = $indRowCols-&gt;{$rcindex};
		}
		else{
			$indRowColsNew{$rcindex} = $indRowCols-&gt;{$rcindex};
		}
	}
	# Copy new to existing:
	%$indRowCols = %indRowColsNew;	
	
	
	$noCols += $lowerLevelHideCols; # Include the lower level detail rows hidden in the internall array update


	# Now Update the internal arrays for the deleted rows ###
	my %expandDataNew;
	foreach my $colIndex(keys %$expandData){
		if($colIndex &gt; ($col+$noCols)){ # adjust rows greater than the current row + detail data
			$expandDataNew{$colIndex-$noCols} = $expandData-&gt;{$colIndex};
		}
		elsif($colIndex&lt;= $col){ # rows less than or equal just get copied
			$expandDataNew{$colIndex} = $expandData-&gt;{$colIndex};
		}
		#else nothing, expand data that is in the detail data that is being hidden doesn't get copied
	}
	# Copy new to existing:
	%$expandData = %expandDataNew;
		

	# Put the state back
	$self-&gt;configure(-state =&gt; $currentState) unless( $currentState eq 'normal');


	return $noCols;


}
#----------------------------------------------
# Sub called when -expandData option changes
#
sub expandData{
	my ($self, $expandData) = @_;



	if(! defined($expandData)){ # Handle case where $widget-&gt;cget(-expandData) is called

		return $self-&gt;{Configure}{-expandData}
				
	}

	$self-&gt;clearSelectors(0);

	my $selectorCol = $self-&gt;cget(-selectorCol);
	
	# Create internal copy of expand Data for us to mess with
	my $expandData_int = {};
	%$expandData_int = %$expandData;
	$self-&gt;{'_expandData'} = $expandData_int;
	
	# update the indRowCols quick lookup hash:
	$self-&gt;updateIndRowCols(0,$expandData, $selectorCol);
	$self-&gt;setSelectors(0);

	
}

sub expandDataCol
{
	my ($self, $expandData) = @_;



	if(! defined($expandData)){ # Handle case where $widget-&gt;cget(-expandData) is called

		return $self-&gt;{Configure}{-expandDataCol}
				
	}

	$self-&gt;clearSelectors(1);

	my $selectorRow = $self-&gt;cget(-selectorRow);
	
	# Create internal copy of expand Data for us to mess with
	my $expandData_int = {};
	%$expandData_int = %$expandData;
	$self-&gt;{'_expandDataCol'} = $expandData_int;
	
	# update the indRowCols quick lookup hash:
	$self-&gt;updateIndRowCols(1,$expandData, $selectorRow);
	
	$self-&gt;setSelectors(1);

	
}



#----------------------------------------------
# Sub called when -selectorCol option changes
#
sub selectorCol{
	my ($self, $selectorCol) = @_;



	if(! defined($selectorCol)){ # Handle case where $widget-&gt;cget(-selectorCol) is called
		#
		# Set default if not defined yet
		my $selCol;
		unless( defined($self-&gt;{Configure}{-selectorCol})){
			$selCol = $self-&gt;{Configure}{-selectorCol} = 0;
		}
		else{
			$selCol = $self-&gt;{Configure}{-selectorCol};
		}
		
		return $selCol;
				
	}

	###### Get Old Selector Col and undo Here ?????###
	$self-&gt;clearSelectors(0);
	
	my $expandData = $self-&gt;cget('-expandData');
	
	# update the indRowCols quick lookup hash:
	$self-&gt;updateIndRowCols(0,$expandData, $selectorCol);
	
	$self-&gt;setSelectors(0);
	
}
sub selectorRow
{
	my ($self, $selectorRow) = @_;



	if(! defined($selectorRow)){ # Handle case where $widget-&gt;cget(-selectorCol) is called
		#
		# Set default if not defined yet
		my $selRow;
		unless( defined($self-&gt;{Configure}{-selectorRow})){
			$selRow = $self-&gt;{Configure}{-selectorRow} = 0;
		}
		else{
			$selRow = $self-&gt;{Configure}{-selectorRow};
		}
		
		return $selRow;
				
	}

	###### Get Old Selector Col and undo Here ?????###
	$self-&gt;clearSelectors(1);
	
	my $expandData = $self-&gt;cget('-expandDataCol');
	
	# update the indRowCols quick lookup hash:
	$self-&gt;updateIndRowCols(1,$expandData, $selectorRow);
	
	$self-&gt;setSelectors(1);
	
}
# Method used to clear the selectors defined in the current indRowCols hash
sub setSelectors{
	my $self = shift;
    my $type = shift ; #1 for rows else for cols
	
	my $indRowCols = $self-&gt;{indRowCols};
	
	my @pluses = grep $indRowCols-&gt;{$_} eq '+', keys %$indRowCols;
	my @minuses = grep $indRowCols-&gt;{$_} eq '-', keys %$indRowCols;
	$self-&gt;tagCell('plus', @pluses);
	$self-&gt;tagCell('minus', @minuses);
	if((defined $type) and ($type == 1))
    {
        my $selectorRow = $self-&gt;cget('-selectorRow');
        my $selectorRowHeight = $self-&gt;cget(-selectorRowWidth)  || 1; # set to '2' (the default), incase this called before the defaults have been set
            $self-&gt;rowHeight($selectorRow, $selectorRowHeight);
    }
    else
    {
        my $selectorCol = $self-&gt;cget('-selectorCol');
        my $selectorColWidth = $self-&gt;cget(-selectorColWidth)  || 2; # set to '2' (the default), incase this called before the defaults have been set
            $self-&gt;colWidth($selectorCol, $selectorColWidth);
    }
	
}




# Method used to clear the selectors defined in the current indRowCols hash
sub clearSelectors{
	my $self = shift;
    my $type = shift ; #1 for rows else for cols
	
	my @indRowCols = keys %{$self-&gt;{indRowCols}};
    if( @indRowCols){
        $self-&gt;tagCell('', keys %{$self-&gt;{indRowCols}});

# Get selectorCol from first entry
        my ($row,$col) = split(',',$indRowCols[0]);
        if((defined $type) and ($type == 1))
        {
            $self-&gt;rowHeight($row,'default');
        }
        else
        {
            $self-&gt;colWidth($col, 'default');
        }
    }
	
}
		

### Method to update indRowCols, based on the expandData and selectorCol
sub updateIndRowCols{

	my $self = shift;
    my $type = shift ; #1 for rows else for cols
	
	my($expandData, $selectorColRow) = @_;

	
	my $indRowCols = {};
	
    if((defined $type) and ($type == 1))
    {
        foreach (keys %$expandData){
            $indRowCols-&gt;{"$selectorColRow,$_"} = '+';
        }
        my $expandDataRow = $self-&gt;cget('-expandData');
        my $selectorCol = $self-&gt;cget('-selectorCol');
        foreach (keys %$expandDataRow){
            $indRowCols-&gt;{"$_,$selectorCol"} = '+';
        }
    }
    else
    {
        foreach (keys %$expandData){
            $indRowCols-&gt;{"$_,$selectorColRow"} = '+';
        }
        my $expandDataCol = $self-&gt;cget('-expandDataCol');
        my $selectorRow = $self-&gt;cget('-selectorRow');
        foreach (keys %$expandDataCol){
            $indRowCols-&gt;{"$selectorRow,$_"} = '+';
        }
    }
	
	$self-&gt;{indRowCols} = $indRowCols;
	return $indRowCols;
	
}
	
# General Motion routine. Calls cellEnter if the pointer has entered another
#  cell.

sub GeneralMotion{

	my $self  = shift;
	my $Ev = $self-&gt;XEvent;

	my $rc = $self-&gt;index('@' . $Ev-&gt;x.",".$Ev-&gt;y);

	$self-&gt;SUPER::GeneralMotion;
	
	my ($row,$col) = split(',',$rc);

	my @border = $self-&gt;border('mark',$Ev-&gt;x,$Ev-&gt;y);
	if( scalar(@border) == 0 &amp;&amp;  (!($self-&gt;{lastrc}) || $rc ne $self-&gt;{lastrc})){ # call cellEnter if cell number has changed and we aren't on a border
		$self-&gt;{lastrc} = $rc;
		$self-&gt;cellEnter($row,$col);
	}
	

		
}

# Method called with the pointer goes over a different cell
#  Sets the cursor to a top-right arrow if over
#  the selectorCol

sub cellEnter{

	my $self  = shift;
	my ($row,$col) = @_;

	#print "Entered '$row,$col'\n";
	
	
	my $rowColResizeDrag = $self-&gt;{rowColResizeDrag};  # Flag = 1 if cursor has been changed for a row/col resize
	
	unless($rowColResizeDrag){
	
		my $indRowCols = $self-&gt;{indRowCols};
		
		if( defined( $indRowCols-&gt;{"$row,$col"})){ 
			#print "Setting ind cursor\n";
			$self-&gt;configure(-cursor =&gt; 'top_left_arrow');
		}
		else{
			#print "Setting old cursor back '".$self-&gt;{normalCursor}."'\n";
			$self-&gt;configure(-cursor =&gt; $self-&gt;{normalCursor});
		}
	}

		
}

		
#############################################################
## Over-ridden beginselect. Epands cell if +/- cell selected
sub BeginSelect{
	my $self  = shift;
	my $rc = shift;
	
	my $indRowCols = $self-&gt;{indRowCols}; # get quick lookup hash
	my $state;
	if( defined($indRowCols-&gt;{$rc})) {
		$state = $indRowCols-&gt;{$rc};
		my ($row,$col) = split(',',$rc);
        if(($col eq $self-&gt;cget('-selectorCol')) or ($col eq 0))
        {
            if( $state eq '-'){
                $self-&gt;hideDetail($row, $self-&gt;{'_expandData'});
            }
            else{
                $self-&gt;showDetail($row);
            }
        }
        else
        {
            if( $state eq '-'){
                $self-&gt;hideDetailCol($col, $self-&gt;{'_expandDataCol'});
            }
            else{
                $self-&gt;showDetailCol($col);
            }
        }

		return;
	}
	
	# print "Calling inherited BeginSelect\n";
	$self-&gt;SUPER::BeginSelect($rc);
	
}


#------------------- 
#  Method Called to adjust spans starting at  $row by $noRows
#
#   If noRows is greater than 0 then the spans are adjusted up by $noRows
#   If noRows is negative, then spans are adjusted down by $noRows
#
#  This method is needed becase the rowinsert/delete methods of TableMatrix don't
#  automatically adjust the spans 
sub adjustSpans{
	
	my $self = shift;
	my ($row,$noRows) = @_;
	
	my %spans = $self-&gt;spans; # Get All Spans
	my %spansFilterd; # filtered for row &gt; $row
	my $minRowFiltered = $row;
	my @filteredIndexes = grep  { my ($r,$c) = split(',',$_); $r &gt;= $minRowFiltered}    keys %spans;
	my %unapplySpans; # temp hash used to unapply spans:
	@unapplySpans{@filteredIndexes} = map '0,0', @filteredIndexes;
	$self-&gt;spans(%unapplySpans);  # unapply the spans the filtered spans:
	my %adjustedSpans;
	foreach (@filteredIndexes){
		my ($r,$c) = split(',',$_);
		$adjustedSpans{($r+$noRows).",$c"} = $spans{$_};
	}
	
	# Apply adjusted Spans:
	$self-&gt;spans(%adjustedSpans);
	
}
sub adjustSpansCol{
	
	my $self = shift;
	my ($col,$noCols) = @_;
	
	my %spans = $self-&gt;spans; # Get All Spans
	my %spansFilterd; # filtered for row &gt; $row
	my $minColFiltered = $col;
	my @filteredIndexes = grep  { my ($r,$c) = split(',',$_); $c &gt;= $minColFiltered}    keys %spans;
	my %unapplySpans; # temp hash used to unapply spans:
	@unapplySpans{@filteredIndexes} = map '0,0', @filteredIndexes;
	$self-&gt;spans(%unapplySpans);  # unapply the spans the filtered spans:
	my %adjustedSpans;
	foreach (@filteredIndexes){
		my ($r,$c) = split(',',$_);
		$adjustedSpans{"$r,".($c+$noCols)} = $spans{$_};
	}
	
	# Apply adjusted Spans:
	$self-&gt;spans(%adjustedSpans);
	
}

1;

</pre></body></html>