Tk-TableMatrix-1.23/0042775002141500001300000000000010551704322013530 5ustar cerneydbteamTk-TableMatrix-1.23/demos/0042775002141500001300000000000010551704244014642 5ustar cerneydbteamTk-TableMatrix-1.23/demos/SpreadsheetHideRows0100775002141500001300000000545310404121614020475 0ustar cerneydbteam# Example of Tk::TableMatrix::SpreadsheetHideRows widget: # Table display with hidden detail data # # This example displays made-up average temperature data # for different time periods (quarter and months), and regions. # Updated to have more spans. 3/8/06. Fully expanding Row 2 and the # lower level Rows should look ok, with the spans restoring back # to where they were. use Tk; use Tk::TableMatrix::SpreadsheetHideRows; my $top = MainWindow->new; my $arrayVar = {}; my @rawdata = (qw/ Quarter Month Region State AvgTemp 1 -- South -- 39 2 -- South -- 61 3 -- South -- 65 4 -- South -- 45 /); foreach my $row (0..4){ foreach my $col (0..5){ next if( $col == 0); $arrayVar->{"$row,$col"} = shift @rawdata; } } my $expandData = { 1 => { data => [ [ '','','Jan', 'South','--',33], [ '','','Feb', 'South','--',38], [ '','','Mar', 'South','--',45], ], tag => 'detail', expandData => { 1 => { data => [ [ '','','', '','Texas',35], [ '','','', '','Ok',36], [ '','','', '','Ark',37], ], tag => 'detail2', }, 2 => { data => [ [ '','','', '','Texas',41], [ '','','', '','Ok',42], [ '','','', '','Ark',43], ], tag => 'detail2', }, 3 => { data => [ [ '','','', '','Texas',51], [ '','','', '','Ok',52], [ '','','', '','Ark',53], ], tag => 'detail2', }, }, }, 2 => { data => [ [ '','','Apr', 'South','--',55], [ '','','May', 'South','--',61], [ '','','Jun', 'South','--',68], ], tag => 'detail', spans => [ 1 => '0,1'], expandData => { 2 => { data => [ [ '','','', '','Texas',58], [ '','','', '','Ok',65], [ '','','', '','Ark',60], ], tag => 'detail2', } } }, 4 => { data => [['','Sorry, Detail Data Not Available Until Next month']], tag => 'detail', spans => [ 1 => '0,3'] }, }; my $t = $top->Scrolled('SpreadsheetHideRows', -rows => 5, -cols => 6, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -selectmode => 'extended', -resizeborders => 'both', -selectorCol => 0, -expandData => $expandData # -state => 'disabled' # -colseparator => "\t", # -rowseparator => "\n" ); # Tags for the detail data: $t->tagConfigure('detail', -bg => 'palegreen', -relief => 'sunken'); $t->tagConfigure('detail2', -bg => 'lightskyblue1', -relief => 'sunken'); $t->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/TableMatrixSpreadsheetTest0100775002141500001300000000162710550771104022033 0ustar cerneydbteam use Tk; use Tk::TableMatrix::Spreadsheet; use Data::Dumper qw( DumperX); my $top = MainWindow->new; my $arrayVar = {}; foreach my $row (0..20){ foreach my $col (0..10){ $arrayVar->{"$row,$col"} = "r$row, c$col"; } } print "Got Here \n"; my $t = $top->Scrolled('Spreadsheet', -rows => 21, -cols => 11, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -selectmode => 'extended', -titlerows => 1, -titlecols => 1, # -state => 'disabled' # -colseparator => "\t", # -rowseparator => "\n" ); #$t->tagConfigure('active', -bg => 'gray90', -relief => 'sunken'); #$t->tagConfigure( 'title', -bg => 'gray85', -fg => 'black', -relief => 'sunken'); # $t->bind("", sub { $t->focus }); $t->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/TableMatrixTest0100775002141500001300000000166007151041755017645 0ustar cerneydbteam use Tk; use Tk::TableMatrix; use Data::Dumper qw( DumperX); my $top = MainWindow->new; my $arrayVar = {}; foreach my $row (0..20){ foreach my $col (0..10){ $arrayVar->{"$row,$col"} = "r$row, c$col"; } } my $t = $top->Scrolled('TableMatrix', -rows => 21, -cols => 11, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -selectmode => 'extended', -resizeborders => 'both', -titlerows => 1, -titlecols => 1, -bg => 'white', # -state => 'disabled' # -colseparator => "\t", # -rowseparator => "\n" ); $t->tagConfigure('active', -bg => 'gray90', -relief => 'sunken'); $t->tagConfigure( 'title', -bg => 'gray85', -fg => 'black', -relief => 'sunken'); # $t->bind("", sub { $t->focus }); $t->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/basic0100775002141500001300000000301607151041756015650 0ustar cerneydbteam## basic ## ## This demo shows the basic use of the table widget ## ## jeff.hobbs@acm.org use Tk; use Tk::TableMatrix; use Data::Dumper qw( DumperX); my $top = MainWindow->new; my $arrayVar = {}; foreach my $row (-1..6){ foreach my $col (-2..5){ $arrayVar->{"$row,$col"} = "r$row, c$col"; } } ## Test out the use of a callback to define tags on rows and columns sub rowSub{ my $row = shift; return "OddRow" if( $row > 0 && $row % 2) } sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } my $label = $top->Label(-text => "TableMatrix v1 Example"); my $t = $top->Scrolled('TableMatrix', -rows => 8, -cols => 8, -width => 6, -height => 6, -titlerows => 1, -titlecols => 2, -variable => $arrayVar, -roworigin => -1, -colorigin => -2, -rowtagcommand => \&rowSub, -coltagcommand => \&colSub, -colstretchmode => 'last', -rowstretchmode => 'last', -selectmode => 'extended', -sparsearray => 0, ); my $button = $top->Button( -text => "Exit", -command => sub{ $top->destroy}); # hideous Color definitions here: $t->tagConfigure('OddRow', -bg => 'orange', -fg => 'purple'); $t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink'); $t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14); $label->pack( -expand => 1, -fill => 'both'); $t->pack(-expand => 1, -fill => 'both'); $button->pack(-expand => 1, -fill => 'both'); my $variable = $t->cget( -var); Tk::MainLoop; Tk-TableMatrix-1.23/demos/buttons0100775002141500001300000000403707151041756016271 0ustar cerneydbteam## buttons.tcl ## ## demonstrates the simulation of a button array ## ## ellson@lucent.com ## modifications made by jeff.hobbs@acm.org ## Mdofied by John Cerney for perl/tk use Tk; use Tk::TableMatrix; use Data::Dumper qw( DumperX); my $top = MainWindow->new; my $tab = {}; my ($rows,$cols) = (10,10); # number of rows/cols # create the table my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -titlerows => 1, -titlecols => 1 , -roworigin => -1, -colorigin => -1 , -colwidth => 4 , -width => 8, -height => 8 , -variable => $tab , -flashmode => 'off', -cursor => 'top_left_arrow' , -borderwidth => 2 , -state => 'disabled' ); $t->pack; # set up tags for the various states of the buttons $t->tagConfigure('OFF', -bg => 'red', -relief => 'raised'); $t->tagConfigure('ON', -bg => 'green', -relief => 'sunken'); $t->tagConfigure('sel', -bg => 'gray75', -relief => 'flat'); # clean up if mouse leaves the widget $t->bind('',sub{ my $w = shift; $w->selectionClear('all'); }); # highlight the cell under the mouse $t->bind('', sub{ my $w = shift; my $Ev = $w->XEvent; if( $w->selectionIncludes('@' . $Ev->x.",".$Ev->y)){ Tk->break; } $w->selectionClear('all'); $w->selectionSet('@' . $Ev->x.",".$Ev->y); Tk->break; ## "break" prevents the call to TableMatrixCheckBorder }); # mousebutton 1 toggles the value of the cell # use of "selection includes" would work here $t->bind('<1>', sub { my $w = shift; $w->focus; my $dude = $w->curselection; my ($rc) = @{$w->curselection}; my $var = $w->cget(-var); if( $var->{$rc} =~ /ON/ ){ $var->{$rc} = 'OFF'; $w->tagCell('OFF',$rc); } else{ $var->{$rc} = 'ON'; $w->tagCell('ON',$rc); } }); # inititialize the array, titles, and celltags for( $i = 0; $i < $rows; $i++){ $tab->{"$i,-1"} = $i; for( $j = 0; $j < $cols; $j++){ unless($i) { $tab->{"-1,$j"}= $j;}; $tab->{"$i,$j"} = "OFF"; $t->tagCell('OFF', "$i,$j"); } } Tk::MainLoop; Tk-TableMatrix-1.23/demos/command0100775002141500001300000000540007151041756016204 0ustar cerneydbteam## command.tcl ## ## This demo shows the use of the table widget's -command options ## ## jeff.hobbs@acm.org ## Converted to perl/tk by John Cerney use Tk; use Tk::TableMatrix; my ($rows,$cols) = (10,10); # number of rows/cols my $top = MainWindow->new; # Sub to fill the array variable sub fill{ my ($array,$x,$y) = @_; my ($i,$j); for( $i = -$x; $i<$x; $i++){ for( $j = -$y; $j<$y; $j++){ $array->{"$i,$j"} = "$i x $j"; } } } ## Test out the use of a callback to define tags on rows and columns sub rowSub{ my $row = shift; return "OddRow" if( $row > 0 && $row % 2) } sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } sub tblCmd{ my ($array, $set, $row,$col,$val) = @_; # my @args = @_; # print "In Table Command, Args = '".join("', '",@args)."'\n"; my $index = "$row,$col"; if( $set ){ $array->{$index} = $val; } else{ if( defined( $array->{$index})){ return $array->{$index}; } else{ return ''; } } } my $label = $top->Label(-text => "TableMatrix -command Example"); # Label the changes with the value of currentTest my $currentText = ''; my $currentLabel = $top->Label(-textvariable => \$currentText); # Entry that changes with the value of activeText my $activeText = ''; my $activeEntry = $top->Entry(-textvariable => \$activeText); my $arrayVar = {}; fill($arrayVar, $rows,$cols); # fill up the array variable my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -width => 6, -height => 6, -titlerows => 1, -titlecols => 2, -command => [\&tblCmd, $arrayVar], -roworigin => -1, -colorigin => -2, -rowtagcommand => \&rowSub, -coltagcommand => \&colSub, -selectmode => 'extended', -flashmode => 'on', -variable => $arrayVar, ); $t->configure( -browsecommand => sub{ my ($index) = @_; $currentText = $index; $activeText = $t->get($index); }); $t->configure( -validate => 1, -validatecommand => sub{ my ($row,$col,$old,$new,$index) = @_; $activeText = $new; return 1; } ); $t->configure( -selectioncommand => sub{ my ($NumRows,$Numcols,$selection,$noCells) = @_; my @args = @_; print "In Selection Command, Args = '".join("', '",@args)."'\n"; return $selection; } ); # hideous Color definitions here: $t->tagConfigure('OddRow', -bg => 'orange', -fg => 'purple'); $t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink'); $t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14); $label->pack( -expand => 1, -fill => 'both'); $currentLabel->pack( -expand => 1, -fill => 'both'); $activeEntry->pack( -expand => 1, -fill => 'both'); $t->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/debug0100775002141500001300000000623707151041756015665 0ustar cerneydbteam## version2.tcl ## ## This demo uses most features of the table widget ## ## jeff.hobbs@acm.org ## Converted to perl/tk by John Cerney use Tk; use Tk::TableMatrix; my ($rows,$cols) = (25,20); # number of rows/cols my $top = MainWindow->new; # Sub to fill the array variable sub fill{ my ($array,$x,$y) = @_; my ($i,$j); for( $i = -$x; $i<$x; $i++){ for( $j = -$y; $j<$y; $j++){ $array->{"$i,$j"} = "r$i,c$j"; } } } ## Test out the use of a callback to define tags on rows and columns sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } my $label = $top->Label(-text => "TableMatrix v2 Example"); my $arrayVar = {}; fill($arrayVar, $rows,$cols); # fill up the array variable my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -variable => $arrayVar, -width => 6, -height => 8, -titlerows => 1, -titlecols => 2, -roworigin => -5, -colorigin => -2, -coltagcommand => \&colSub, -selectmode => 'extended', -selecttitles => 0, -drawmode => 'single', ); my $button = $top->Button( -text => "Exit", -command => sub{ $top->destroy}); $label->pack( -expand => 1, -fill => 'both'); $t->pack(-expand => 1, -fill => 'both'); $button->pack(-expand => 1, -fill => 'both'); # hideous Color definitions here: $t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink'); $t->tagConfigure('title', -bg => 'red', -fg => 'blue', -relief => 'sunken'); $t->tagConfigure('dis', -state => 'disabled'); my $i = -1; my $first = $t->cget(-colorigin); my $anchor; foreach $anchor( qw/ n s e w nw ne sw se c /){ $t->tagConfigure($anchor, -anchor => $anchor); $t->tagRow($anchor, ++$i); $t->set( "$i,$first",$anchor); } $top->fontCreate('courier', -family => 'courier', -size => 10); $t->tagConfigure('s', -font => 'courier', -justify => 'center'); # $initWindow->Label(-image => $top->Photo(-file => Tk->findINC('Xcamel.gif')))->pack; my $perltkLogo = $top->Photo(-file => Tk->findINC('Xcamel.gif')); $t->tagConfigure('logo', -image => $perltkLogo, -showtext => 1); $t->tagCell('logo', '1,2', '2,3', '4,1'); $t->tagCell('dis', '2,1', '1,-1', '3,0'); $t->colWidth(qw/ -2 8 -1 9 0 12 4 14/); $t->set( '1,1' => "multi-line\ntext\nmight be\ninteresting" , '3,2' => "more\nmulti-line\nplaying\n" , '2,2' => "null\0byte" ); $i = -1; # This is in the row span my $l = $top->Label(-text => "Window s", -bg => 'yellow'); $t->windowConfigure("6,0", -sticky => 's', -window => $l); # This is in the row titles $l = $top->Label(-text => "Window ne", -bg => 'yellow'); $t->windowConfigure("4,-1", -sticky => 'ne', -window => $l); # This will get swallowed by a span $l = $top->Label(-text => "Window ew", -bg => 'yellow'); $t->windowConfigure("5,3", -sticky => 'ew', -window => $l); # This is in the col titles $l = $top->Label(-text => "Window nsew", -bg => 'yellow'); $t->windowConfigure("-5,1", -sticky => 'nsew', -window => $l); $l = $t->parent->Label(-text => "Sibling l", -bg => 'orange'); $t->windowConfigure("5,1", -sticky => 'nsew', -window => $l); $t->spans( '-1,-2' => '0,3', '1,2' => '0,5','3,2' => '2,2', '6,0' => '4,0'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/dynarows0100775002141500001300000000515107151041756016437 0ustar cerneydbteam## dynarows.tcl ## ## This demos shows the use of the validation mechanism of the table ## and uses the table's cache (no -command or -variable) with a cute ## dynamic row routine. ## ## jeff.hobbs@acm.org ## Converted to perl/tk by John Cerney use Tk; use Tk::TableMatrix; use Date::Parse; use Date::Format; my $top = MainWindow->new; my $t = $top->Scrolled('TableMatrix', -rows => 2, -cols => 3, -cache => 1, -selecttype => 'row', -titlerows => 1, -titlecols => 1, -height => 5, -autoclear => 1, ); $t->configure( -browsecommand => sub{ my ($index) = @_; my $val = $t->get($index); return unless $val; my ($row,$col) = split(",",$index); ## Entries in the last row are allowed to be empty my $nrows = $t->cget(-rows); if( ($row == ($nrows-1)) && $val eq ''){ return; }; return if( $row == 0 || $col == 0); #don't check the title row/cols my $timenumber; # try to parse date from value in cell $timenumber = str2time($val); if( !$timenumber || !$val){ # not a valid date: print "'$val' is not a valid date\n"; $t->bell; $t->activate($index); $t->selectionClear('all'); $t->selectionSet('active'); $t->see('active'); } else{ # Convert to a common date format my $date; $date = time2str("%m/%d/%Y",$timenumber); $t->set($index,$date); if( $row == ($nrows-1) ){ ## if this is the last row and both cols 1 && 2 are not empty ## then add a row and redo configs if( $t->get("$row,1") ne '' && $t->get("$row,2") ne ''){ $t->tagRow('', $row); $t->set("$row,0", $row); $t->configure( -rows => ++$nrows); $t->tagRow('unset', ++$row); $t->set("$row,0","*"); $t->see("$row,1"); $t->activate("$row,1"); } } } }); $t->set("0,1" => "Begin", "0,2" => 'End', "1,0"=>"*"); # hideous Color definitions here: $t->tagConfigure('unset', -fg => '#008811'); $t->tagConfigure('title', -fg => 'red'); $t->tagRow('unset', 1); $t->colWidth( 0 => 3); my $label = $top->Label(-text => "Dynamic Date Validated Rows"); $label->pack( -expand => 1, -fill => 'both'); $t->pack(-expand => 1, -fill => 'both'); # Bindings: # Make the active area move after we press return: # We Have to use class binding here so that we override # the default return binding $t->bind('Tk::TableMatrix','', sub{ my $r = $t->index('active', 'row'); my $c = $t->index('active', 'col'); if( $c == 2){ $t->activate(++$r.",1"); } else{ $t->activate("$r,".++$c); } $t->see('active'); Tk->break; }); # Make enter do the same thing as return: $t->bind('', $t->bind('')); Tk::MainLoop; Tk-TableMatrix-1.23/demos/edit_styles.pl0100775002141500001300000001756607734032044017545 0ustar cerneydbteam## edit_styles.pl ## ## demonstrates different edit styles within cells ## ## ewaldhei@idd.com ## This script uses tags and some logic to simulate check ## buttons, browseEntries, etc in cells. This approach is ## faster than using embedded windows, especially for large ## tables. use Tk; use Tk::TableMatrix; main(); sub main { my $top = MainWindow->new; my $_data = {}; my ($rows,$cols) = (12,7); # number of rows/cols # create the table my $t = $top->Scrolled (TableMatrix => -rows => $rows, -cols => $cols, -titlerows => 1, -titlecols => 1, -width => 8, -height => 8 , -colwidth => 11, -variable => $_data, -cursor => 'top_left_arrow' , -borderwidth => 2 , -ipadx => 15, -scrollbars => 'se', )->pack(qw/-expand 1 -fill both/); my $tm = $t->Subwidget('scrolled'); $tm->{columneditstyles} = {qw(1 readonly 2 editable 3 button 4 optionmenu 5 browseentry 6 checkbutton )}; # set up tags for the various states of the buttons $t->tagConfigure('OFF', -bg => 'gray60', -relief => 'raised'); $t->tagConfigure('ON', -bg => 'gray80', -relief => 'sunken'); $t->tagConfigure('sel', -bg => 'gray70', -relief => 'flat'); $t->tagConfigure('readonly', -relief => 'groove'); my %images = define_bitmaps($top); $t->tagConfigure('optionmenu', -image => $images{optionmenu}, -anchor => 'e', -showtext => 1, ); $t->tagConfigure('browseentry', -image => $images{browseentry}, -anchor => 'e', -showtext => 1); $t->tagConfigure('checkbutton0', -image => $images{checkbutton0}); $t->tagConfigure('checkbutton1', -image => $images{checkbutton1}); $t->bind('' => \&end_edit); # clean up if mouse leaves the widget $t->bind('',sub { my $w = shift; $w->selectionClear('all'); $w->configure(-state => 'disabled'); }); # highlight the cell under the mouse $t->bind('', sub { my $w = shift; my $Ev = $w->XEvent; if( $w->selectionIncludes('@' . $Ev->x.",".$Ev->y)){ Tk->break; } $w->selectionClear('all'); $w->selectionSet('@' . $Ev->x.",".$Ev->y); Tk->break; ## "break" prevents the call to TableMatrixCheckBorder }); # mousebutton 1 edits the cell (or not) appropriately $t->bind('<1>', sub { my ($w) = @_; withdraw_edit_widgets($w); my $Ev = $w->XEvent; my ($x, $y) = ($Ev->x, $Ev->y); my $rc = $w->index("\@$x,$y"); my $var = $w->cget(-var); my ($r, $c) = split(/,/, $rc); $r && $c || return; $w->{_b1_row_col} = "$r,$c"; set_style_state($w); my $style= $w->{columneditstyles}{$c} || 'editable'; if ($style eq 'optionmenu' || $style eq 'browseentry') { setup_toplevel_lbox($w, $r, $c); } elsif ($style eq 'button') { my $newval = $var->{$rc} =~ /ON/ ? 'OFF' : 'ON'; $var->{$rc} = $newval; $w->tagCell($newval, $rc); } elsif ($style eq 'checkbutton') { $var->{$rc} = !$var->{$rc}; my $tag = $var->{$rc} ? 'checkbutton1' : 'checkbutton0'; $w->tagCell($tag, $rc); } }); # replace std b1-release $t->bind('Tk::TableMatrix' => '', \&set_style_state); # inititialize the array, titles, and celltags for (my $r = 0; $r < $rows; $r++) { for (my $c = 0; $c < $cols; $c++) { my $rc = "$r,$c"; if (!$r || !$c) { $_data->{$rc} = $r || $tm->{columneditstyles}{$c} || ""; } else { $_data->{$rc} = $rc; my $style = $tm->{columneditstyles}{$c} || 'editable'; if ($style eq 'readonly') { $t->tagCell('readonly', $rc); } if ($style eq 'optionmenu') { $_data->{$rc} = "$r options"; $t->tagCell('optionmenu', $rc); } elsif ($style eq 'browseentry') { $_data->{$rc} = "browse$r"; $t->tagCell('browseentry', $rc); } elsif ($style eq 'button') { $_data->{$rc} = $r % 4 ? 'ON' : 'OFF'; $t->tagCell($_data->{$rc}, $rc); } elsif ($style eq 'checkbutton') { $_data->{$rc} = $r % 3 ? 0 : 1; $t->tagCell('checkbutton' . $_data->{$rc}, $rc); } } } } Tk::MainLoop; } sub set_style_state { my ($w) = @_; my ($r, $c) = split(/,/, $w->{_b1_row_col}); if (grep(!$w->{columneditstyles}{$c} || $_ eq $w->{columneditstyles}{$c}, qw(optionmenu readonly button checkbutton))) { $w->selectionClear('all'); $w->configure(state => 'disabled'); } else { $w->configure(state => 'normal'); $w->activate($w->{_b1_row_col}); } } sub end_edit { my ($w) = @_; $w->configure(-state => 'disabled'); $w->selectionClear('all'); } sub setup_toplevel_lbox { my ($w, $r, $c) = @_; my $toplevel = $w->{toplevel} ||= $w->Toplevel(-bd => 2, -relief => 'raised'); my $lbox = $toplevel->{lbox}; $lbox->destroy() if $lbox; $toplevel->overrideredirect(1); my @options = map(chr(ord('A') + $_ - 1) x $_, 1..$r); my $height = @options > 8 ? 8 : (@options || 1); my $width = 2; foreach (@options) { $width = length($_) if length($_) > $width; } $lbox = $toplevel->{lbox} = $toplevel->Scrolled (Listbox => -height => $height, -width => $width + 1, -relief => 'raised', -borderwidth => 1, -highlightthickness => 0, -bg => $w->cget('bg'), -scrollbars => 'oe', )->pack(-side => 'left'); $lbox->Subwidget('scrolled')->{_table_matrix} = $w; $lbox->delete(0, 'end'); $lbox->insert(0, @options); my ($gx, $gy) = ($w->rootx(), $w->rooty()); my @bbox = $w->bbox("$r,$c"); my ($mx, $my) = (int($gx + $bbox[0] + $bbox[2]), int($gy + $bbox[1])); my $toplevel_ypixels = $height * $bbox[3] + $toplevel->cget("-bd") * 2 + $toplevel->cget("-highlightthickness"); my $y2 = $my + $toplevel_ypixels; $my = $w->vrootheight - $toplevel_ypixels if ($y2 > $w->vrootheight); $toplevel->transient($w->toplevel()); $toplevel->geometry("+$mx+$my"); $toplevel->deiconify(); $toplevel->raise(); $lbox->bind('', sub { my ($lbox) = @_; my $i = $lbox->curselection(); my $val = $lbox->get($i); my $w = delete $lbox->{_table_matrix}; my $rc = delete $w->{_b1_row_col}; my $var = $w->cget(-var); $var->{$rc} = $val; $w->set($rc => $val); $w->selectionClear('all'); $w->configure(-state => 'disabled'); withdraw_edit_widgets($w); } ); } sub withdraw_edit_widgets { my ($w) = @_; my $toplevel = $w->{toplevel}; if ($toplevel && $toplevel->state eq 'normal') { $toplevel->withdraw(); } } #-------------------------------------------------------------- sub define_bitmaps { my ($w) = @_; my $optionmenu = ' /* XPM */ static char * xpm[] = { "11 5 3 1", " c None", "+ c #D0D0D0", "@ c #555555", "+++++++++++", "++++++++++@", "++ @@", "++@@@@@@@@@", "+@@@@@@@@@@"}; '; my $browseentry = ' /* XPM */ static char * xpm[] = { "11 7 3 1", " c None", "+ c #D0D0D0", "@ c #555555", "+++++++++++", "++++++++++@", "+++ @@@", " +++ @@@ ", " +++ @@@ ", " ++@@@ ", " @@@ ", }; '; my $cbutton0 = ' /* XPM */ static char * xpm[] = { "9 8 3 1", " c None", "@ c #B8B8B8", "+ c #555555", "+++++++++", "++++++++@", "++ @@", "++ @@", "++ @@", "++ @@", "++@@@@@@@", "+@@@@@@@@"}; }; '; my $cbutton1 = ' /* XPM */ static char * xpm[] = { "9 8 4 1", " c None", "@ c #B8B8B8", "+ c #555555", ". c #FF0000", "+++++++++", "++++++++@", "++.....@@", "++.....@@", "++.....@@", "++.....@@", "++@@@@@@@", "+@@@@@@@@"}; }; '; my %images; $images{optionmenu} = $w->Pixmap('optionmenu', -data => $optionmenu); $images{browseentry} = $w->Pixmap('browseentry', -data => $browseentry); $images{checkbutton0} = $w->Pixmap('cbutton0', -data => $cbutton0); $images{checkbutton1} = $w->Pixmap('cbutton1', -data => $cbutton1); %images; } Tk-TableMatrix-1.23/demos/embeddedWindows.pl0100664002141500001300000000350407606641130020301 0ustar cerneydbteam########## ### Demo of using embedded windows in TableMatrix ### This works well, but can be slow for very large tables with many ### windows. ### ### See edit_styles.pl for an alternative that is faster for larger ### tables use Tk; use Tk::BrowseEntry; use Tk::TableMatrix; use Data::Dumper qw( DumperX); my $top = MainWindow->new; my $arrayVar = {}; foreach my $row (0..20){ foreach my $col (0..10){ $arrayVar->{"$row,$col"} = "r$row, c$col"; } } my $t = $top->Scrolled('TableMatrix', -rows => 21, -cols => 11, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -selectmode => 'extended', -resizeborders => 'both', -titlerows => 1, -titlecols => 1, -bg => 'white', # -state => 'disabled' # -colseparator => "\t", # -rowseparator => "\n" ); $t->tagConfigure('active', -bg => 'gray90', -relief => 'sunken'); $t->tagConfigure( 'title', -bg => 'gray85', -fg => 'black', -relief => 'sunken'); ################ Put in some embedded windows ################ my $l = $top->Checkbutton(-text => 'CheckButton'); $t->windowConfigure("3,3", -sticky => 's', -window => $l); my $c = $top->BrowseEntry(-label => "Month:"); $c->insert("end", "January"); $c->insert("end", "February"); $c->insert("end", "March"); $c->insert("end", "April"); $c->insert("end", "May"); $c->insert("end", "June"); $c->insert("end", "July"); $c->insert("end", "August"); $c->insert("end", "September"); $c->insert("end", "October"); $c->insert("end", "November"); $c->insert("end", "December"); $t->windowConfigure("2,2", -sticky => 'ne', -window => $c); # Leave enough room for the windows $t->colWidth(2,20); $t->colWidth(3,20); $t->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/maxsize0100775002141500001300000000366107151041756016255 0ustar cerneydbteam## maxsize.tcl ## ## This demo uses a really big table. The big startup time is in ## filling the table's Tcl array var. ## ## jeff.hobbs@acm.org ## Converted to perl/tk by John Cerney 7/24/00 use Tk; use Tk::TableMatrix; my $top = MainWindow->new; my $arrayVar = {}; print "Filling Array...\n"; my ($rows,$cols) = (40000, 10); foreach my $row (0..($rows-1)){ foreach my $col (0..($cols-1)){ $arrayVar->{"$row,$col"} = "$row,$col"; } } print "Creating Table...\n"; ## Test out the use of a callback to define tags on rows and columns sub colSub{ my $col = shift; return "OddCol" if( $col > 0 && $col%2) ; } my $label = $top->Label(-text => "TableMatrix v2 Example"); my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -coltagcommand => \&colSub, -colstretchmode => 'last', -rowstretchmode => 'last', -selectmode => 'extended', -selecttitles => 0, -drawmode => 'slow', ); my $button = $top->Button( -text => "Exit", -command => sub{ $top->destroy}); # hideous Color definitions here: $t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink'); $t->tagConfigure('title', -bg => 'red', -fg => 'blue', -relief => 'sunken'); $t->tagConfigure('dis', -state => 'disabled'); my $i = -1; my $first = $t->cget(-colorigin); my $anchor; foreach $anchor( qw/ n s e w nw ne sw se c /){ $t->tagConfigure($anchor, -anchor => $anchor); $t->tagRow($anchor, ++$i); $t->set( "$i,$first",$anchor); } $top->fontCreate('courier', -family => 'courier', -size => 10); $t->tagConfigure('s', -font => 'courier', -justify => 'center'); $t->colWidth( -2 => 8, -1 => 9, 0=> 12, 4=> 14); $label->pack( -expand => 1, -fill => 'both'); $t->pack(-expand => 1, -fill => 'both'); $button->pack(-expand => 1, -fill => 'both'); Tk::MainLoop; Tk-TableMatrix-1.23/demos/spreadsheet0100775002141500001300000000642410011324171017064 0ustar cerneydbteam## spreadsheet.tcl ## ## This demos shows how you can simulate a 3D table ## and has other basic features to begin a basic spreadsheet ## ## jeff.hobbs@acm.org ## Converted to perl/tk by John Cerney use Tk; use Tk::TableMatrix; my ($rows,$cols) = (10,10); # number of rows/cols my $page = 'AA'; my $oldPage = ''; my $tableColors = { default => 'pink',AA => 'orange', BB => 'blue', CC => 'green'}; my $top = MainWindow->new; sub colorize{ my ($num) = @_; return 'colored' if( $num > 0 && $num%2); return ''; } # Sub to fill the array variable sub fill{ my ($name, $array,$r,$c) = @_; my ($i,$j); $r ||= $rows; $c ||= $cols; for( $i = 0; $i<$r; $i++){ for( $j = 0; $j<$c; $j++){ if( $j && $i){ $array->{"$i,$j"} = "$name $i,$j"; } elsif( $i ){ $array->{"$i,$j"} = "$i"; } elsif( $j ){ $array->{"$i,$j"} = sprintf("%c",($j+64)); } } } } my $arrayVar = { AA => {}, BB => {}, CC => {}}; fill('AA',$arrayVar->{AA}, $rows,$cols); # fill up the array variable fill('BB',$arrayVar->{BB}, $rows/2,$cols/2); # fill up the array variable my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols, -width => 5, -height => 5, -titlerows => 1, -titlecols => 1, -coltagcommand => \&colorize, -selectmode => 'extended', -flashmode => 'on', -variable => $arrayVar->{$page}, ); my $label = $top->Label(-text => "TableMatrix vs Spreadsheet Example"); # Label the changes with the value of currentTest my $currentText = ''; my $currentLabel = $top->Label(-textvariable => \$currentText); # Entry that changes with the value of activeText my $activeText = ''; my $activeEntry = $top->Entry(-textvariable => \$activeText); my $pageLabel = $top->Label(-text => 'PAGE:', -width => 6, -anchor => 'e'); my $pageSelect = $top->Optionmenu( -options => [ qw/ AA BB CC/], -variable => \$page, -command => [ \&changepage]); sub changepage{ my ($newPage) = @_; if( $newPage ne $oldPage){ $t->selectionClear('all'); $t->activate(''); # unactivate anything $t->configure(-variable => $arrayVar->{$newPage}); # $e config -textvar ${i}(active) $t->activate('origin'); if( exists $tableColors->{$newPage}){ $t->tagConfigure('colored', -bg => $tableColors->{$newPage}); } else{ $t->tagConfigure('colored', -bg => $tableColors->{'default'}); } $t->see('active'); $oldPage = $newPage; } } $t->configure( -browsecommand => sub{ my ($oldindex,$index) = @_; $currentText = $index; $activeText = $t->get($index); }); # hideous Color definitions here: $t->tagConfigure('colored', -bg => $tableColors->{$page}); $t->tagConfigure('title', -fg => 'red', -relief => 'groove'); $t->tagConfigure('blue', -bg => 'blue'); $t->tagConfigure('green', -bg => 'green'); $t->tagCell('green', '6,3','5,7','4,9'); $t->tagCell('blue', '8,8'); $t->tagRow('blue', 7); $t->tagCol('blue', 6,8); $t->colWidth( 0 => 3, 2 => 7); $label->grid( '-', '-', '-', '-', '-sticky' => 'ew'); $currentLabel->grid( $currentLabel, $activeEntry, $pageLabel, $pageSelect, '-', '-sticky' => 'ew'); $t->grid( '-', '-', '-', '-', '-sticky' => 'nsew'); $top->gridColumnconfigure(1, -weight => 1); $top->gridRowconfigure(2, -weight => 1); Tk::MainLoop; Tk-TableMatrix-1.23/demos/tagBorderWidth0100664002141500001300000000221707560563436017507 0ustar cerneydbteam# Script show the new multi-number borderwidth option for tags # Borderwidth can be specified as a space separated list of # 4 numbers representing left right top bottom borders drawn in a cell # # In this example, the tag'ed row will have a large top/bottom border, and a normal # size left/right border use Tk; use Tk::TableMatrix; use strict; my $mw = MainWindow->new; #$mw->optionAdd('*background', 'blue', 'interactive'); $mw->optionAdd('*tablematrix*background', 'skyblue'); my $table = $mw->TableMatrix(-rows => 5, -cols => 8, -cache => 1, #-bg => 'blue', ); $table->pack(-expand => 1, -fill => 'both'); $table->tagConfigure("invalid", -background => 'red', -relief => 'raised', -bd => '1 1 5 5'); $table->tagConfigure("left", -anchor => 'w'); foreach my $row (0..4) { #$table->tagRow('invalid', $row); # swap foreach my $column (0..7) { $table->set("$row,$column", "hello"); #$table->tagCell('left', "$row,$column"); # swap } } $table->tagCell('left', '2,3'); $table->tagRow('invalid', 2); MainLoop; Tk-TableMatrix-1.23/demos/tagMerge0100664002141500001300000000172507455367560016337 0ustar cerneydbteam# Script show tag merging behavior with an option set in the # option database. # # Should display with one row hightlighted red and a cell in the row left-justified use Tk; use Tk::TableMatrix; use strict; my $mw = MainWindow->new; #$mw->optionAdd('*background', 'blue', 'interactive'); $mw->optionAdd('*tablematrix*background', 'skyblue'); my $table = $mw->TableMatrix(-rows => 5, -cols => 8, -cache => 1, #-bg => 'blue', ); $table->pack(-expand => 1, -fill => 'both'); $table->tagConfigure("invalid", -background => 'red'); $table->tagConfigure("left", -anchor => 'w'); foreach my $row (0..4) { #$table->tagRow('invalid', $row); # swap foreach my $column (0..7) { $table->set("$row,$column", "hello"); #$table->tagCell('left', "$row,$column"); # swap } } $table->tagCell('left', '2,3'); $table->tagRow('invalid', 2); MainLoop; Tk-TableMatrix-1.23/demos/tagMerge20100664002141500001300000000256007560563437016415 0ustar cerneydbteam# Script show tag merging behavior with an option set in the # option database. # # Should display with one row hightlighted red and a cell in the row left-justified use Tk; use Tk::TableMatrix; use strict; my $mw = MainWindow->new; #$mw->optionAdd('*background', 'blue', 'interactive'); $mw->optionAdd('*tablematrix*background', 'skyblue'); my $table = $mw->TableMatrix(-rows => 5, -cols => 8, -cache => 1, #-bg => 'blue', ); $table->pack(-expand => 1, -fill => 'both'); foreach my $row (0..4) { #$table->tagRow('invalid', $row); # swap foreach my $column (0..7) { $table->set("$row,$column", "hello"); #$table->tagCell('left', "$row,$column"); # swap } } # 'invalid' tag takes priority of 'left' tag, because it is created first, # so the cell 2,3 should be red and center anchored, but see below... $table->tagConfigure("invalid", -background => 'red', -anchor => 'center'); $table->tagConfigure("left", -background => 'green', -anchor => 'w'); $table->tagCell('left', '2,3'); $table->tagRow('invalid', 2); # The tag priority is changed, so the cell 2,3 will be gree and 'w' achored. $table->tagRaise('left', 'invalid'); # This would have the same effect as the above tagRaise #$table->tagLower('invalid', 'left'); MainLoop; Tk-TableMatrix-1.23/COPYING0100775002141500001300000000212507544323470014572 0ustar cerneydbteamCopyright (c) 2000-2002 John Cerney. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself, with the exception of the files in the pTk sub-directory which have separate terms derived from those of the original Tk4.0 sources and/or TkTable. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. See pTk/license.terms for details of this Tk license, and the source code in pTk/mTk/Tktable for the TkTable license. Tk-TableMatrix-1.23/Changes0100664002141500001300000000572010550772123015025 0ustar cerneydbteamSummary of Changes to Tk::TableMatrix See ChangeLog for detailed changes. Release 1.23 1/9/2007 * Changed TableMatrix::Spreadsheet row/col resize behavior to be more spreadsheet-like. Release 1.22 3/23/06 * Misc Bugs fixed in Tk::TableMatrix::SpreadsheetHideRows Release 1.21 3/2/06 * Updated to make the row/size resize operation (that happens when you drag the row/col borders) apply to every row or column that is currently selected, instead of just the row/col border that was dragged. Release 1.2 1/26/05 * Fixed bug which was causing crashes on perl 5.8.4 on win32 when anything was copied into the clipboard (i.e. when control-c pressed). * Fixed row/col insert/deletes to work more reliably in TableMatrix::Spreadsheet Release 1.1: 2/12/04 * Updated to be compatible with the new Tk804 series. Release 1.01: 12/6/02 * Fixed Error where the rowHeight method was getting executed like a colWidth. This was introduced in the update of TkTable 2.5 to 2.6 Release 1.0: 12/2/02 * Updated core C-code for the changes made from TkTable 2.6 to 2.8. (Tk::TableMatrix is derived from the TkTable Tcl/Tk Widget. See tktable.sourceforge.net ) From the TkTable 2.7 and 2.8 Release Notes: * Corrected memory leaks in caching. * Added the ability to select borders with Button1. * Added global -justify option. * Added -ipadx/-ipady table options and swapped them with the old -padx/-pady. This gives better control over the cell padding. **** POTENTIAL INCOMPATABILITY **** * -borderwidth now takes up to 4 values to allow you to customize edge edge of a cell. * Added priorities to tags, so tags can be raised and lowered in priority. **** POTENTIAL INCOMPATABILITY **** * Numerous minor bugs fixed. Release 0.9: 5/22/02 * Added an experimental widget: SpreadsheetHideRows. This enables display of tabular info, with selectable hide/unhide of detail data. See demos/SpreadsheetHideRows * Numerous minor bugs fixed. Release 0.8: 10/5/01 * Removed un-needed dependencies on Data::Parse and Date::Format for TableMatrix::Spreadsheet * Fixed problem with the selection going nuts when dragging the selection out of the window. Release 0.71: 6/15/01 * Fixed to compile with the new Tk800.023 release. Release 0.7: 6/7/01 * Added TableMatrix::Spreadsheet widget. This is a TableMatrix Derived widget with Excel-like bindings. * Reverted back to the cell sorting method implemented in tktable 2.5 (and TableMatrix 0.3). The new cell sorting method didn't sort negative row/column indexes correctly, which caused the data from a copy/paste operation to be out-of-order, if the selection included multiple negative row/col indexes. * Fixed control +/- key bindings for modifying the column with. (Patch from Slaven) Release 0.5: 12/20/00 * Updated to be consistent with tkTable 2.6 Release 0.3 9/16/00 * Initial Release (based on tkTable 2.5) Tk-TableMatrix-1.23/Makefile.PL0100764002141500001300000000774110551570727015521 0ustar cerneydbteamuse 5.00404; use Cwd; use Config; no lib '.'; BEGIN { warn("### Note: 'Building Outside of Tk itself' Messages are Expected Here ####\n"); $IsWin32 = ($^O eq 'MSWin32' || $Config{'ccflags'} =~ /-D_?WIN32_?/); $VERSION = '1.23'; $win_arch = shift @ARGV if @ARGV and $ARGV[0] =~ /^(open32|pm|x|MSWin32)$/; require('fix_4_os2.pl'), OS2_massage() if $^O eq 'os2'; $win_arch = ($IsWin32) ? 'MSWin32' : 'x' if not defined $win_arch; # Currently 'x', 'pm', 'open32', 'MSWin32' require "./myConfig"; # use lib ($Tk::MMutil::dir=getcwd); } use Tk::MMutil; # Get existing tk version for figuring $tkversion = eval 'use Tk; $Tk::VERSION;'; #print "################tkversion = $tkversion\n"; my $mydefine =''; if( $tkversion < 804.000 ){ # Tk 800 and below need the old-style XSTkCommand call # in TableMatrix.xs $mydefine .= " -DTK800XSTK"; } if ($IsWin32) { *MY::makeaperl = \&makeWin32perl; if ($Config{cc} =~ /^gcc/i) { @libs = (''); } } else { my $plibs = $Config{'libs'}; my $libs = "$xlib -lX11"; # Used to have -lpt in here as well. my @try = qw(-lsocket -lnsl -lm); push(@try,'-lc') if $^O =~ /svr4/i; my $lib; # perl needs sockets and math library too # so only include these if they made it through perl's Configure foreach $lib (@try) { $libs .= " $lib" if ($plibs =~ /$lib\b/); } @libs = ("$libs"); } my $dir = Tk::MMutil::find_subdir(); delete $dir->{'pTk'}; # Find path to existing pTk include files my $ptkPath = Tk::MMutil::findINC('Tk/pTk/Lang.h'); $ptkPath =~ s/\/Lang.h$//g; Tk::MMutil::TkExtMakefile( 'VERSION' => $VERSION, 'XS_VERSION' => $VERSION, 'EXE_FILES' => [], 'NAME' => 'Tk::TableMatrix', 'DIR' => ['pTk',reverse(sort(keys %$dir))], 'DISTNAME' => "Tk-TableMatrix", 'DEFINE' => $mydefine, 'MYEXTLIB' => 'pTk/libpTk$(LIB_EXT)' . ($win_arch =~ /^(open32|pm)$/ ? ' pTk/dllInit$(LIB_EXT)' : ''), 'INC' => "-I$ptkPath", 'LIBS' => \@libs, 'OBJECT' => '$(O_FILES)', 'clean' => { FILES => 'pTk/tkConfig.h ' }, 'PREREQ_PM' => { Tk => 800.022}, @macro ); sub MY::top_targets { my ($self) = @_; my $str = $self->MM::top_targets; $str =~ s/\bmanifypods\b/html/g; return $str; } sub MY::post_initialize { my ($self) = @_; my ($ret) = ''; my %files = (); my $dir = $self->catdir('$(INST_ARCHLIBDIR)','Tk'); my $name; foreach $name (grep /(%|\.q4|\.bck|\.old)$/,keys %{$self->{PM}}) { delete $self->{PM}->{$name}; } # delete $self->{PM}->{'Tk/Config.pm'}; # $self->{PM}->{'Tk/Config.pm'} = $self->catfile($dir,'Config.pm'); # $files{'typemap'} = 1; foreach $name ($self->lsdir(".")) { next if ($name =~ /^\./); next unless (-f $name); $files{$name} = 1 if ($name =~ /\.[tm]$/); $files{$name} = 1 if ($name =~ /\.def$/); } foreach $name (sort(@{$self->{H}},keys %files)) { $self->{PM}->{$name} = $self->catfile($dir,$name); } $ret; } sub needs_Test { my $file = shift; local $_; unless (open(TFILE,"$file")) { warn "Cannot open $file:$!"; return 1; } my $code = 0; while () { last if ($code = /^\s*(use|require)\s+Test\b/); } close(TFILE); warn "Skipping test $file needs 'Test.pm':$_" if $code; return $code; } sub MY::test { my ($self,%attrib) = @_; my @tests = sort glob($self->catfile('t','*.t')); eval { require Test }; if ($@) { @tests = grep(!needs_Test($_),@tests); } $attrib{'TESTS'} = join(' ',@tests); # Temporarily remove sub-dirs from $self as we 'know' # there are no tests down there my $dir = delete $self->{'DIR'}; my $str = $self->MM::test(%attrib); # Put sub-dirs back $self->{'DIR'} = $dir; return $str; } sub MY::postamble { ' html : subdirs manifypods @cd pod && $(MAKE) html $(PASTHRU) Makefile : myConfig $(MYEXTLIB) : config FORCE cd pTk && $(MAKE) perlmain.c : config Makefile pTk/tk.res : $(MYEXTLIB) basic : $(INST_DYNAMIC) pm_to_blib MANIFEST : MANIFEST.SKIP $(FIRST_MAKEFILE) $(MAKE) manifest '; } Tk-TableMatrix-1.23/README0100775002141500001300000000646507572700004014423 0ustar cerneydbteam/* * This is a port of the tcl/tk Tktable Widget version 2.8 to perl/tk */ ************************************* The Tk::TableMatrix Widget ************************************* INTRODUCTION Tk::TableMatrix is a table/matrix widget extension to perl/tk for displaying data in a table (or spreadsheet) format. The basic features of the widget are: * multi-line cells * support for embedded windows (one per cell) * row & column spanning * variable width columns / height rows (interactively resizable) * row and column titles * multiple data sources ((perl hash|| perl callback) &| internal caching) * supports standard Tk reliefs, fonts, colors, etc. * x/y scrollbar support * 'tag' styles per row, column or cell to change visual appearance * in-cell editing - returns value back to data source * support for disabled (read-only) tables or cells (via tags) * multiple selection modes, with "active" cell * multiple drawing modes to get optimal performance for larger tables * optional 'flashes' when things update * cell validation support * Works everywhere Tk does (including Windows and Mac!) (Note perltk version has only been tested on Solaris, Linux, win98/NT/mingw32 as of 11/12/02) FINDING THE WIDGET The Section TBD BUILDING AND INSTALLING THE WIDGET 1. Uncompress and unpack the distribution ON UNIX: gzip -d Tk-TableMatrix.tar.gz tar -xf Tk-TableMatrix.tar ON WINDOWS: use something like WinZip to unpack the archive. This will create a subdirectory TableMatrix with all the files in it. 2. Build/Test perl Makefile.PL make make test There are also some demos in the demo directory: perl -Mblib demos/TableMatrixTest perl -Mblib demos/spreadsheet . . etc. 3. Install make install 4. Read the documentation The tcl/tk html documentation has been translated to TableMatrix.pod. You can read it using the standard 'perldoc Tk::TableMatrix' command. THINGS TO WATCH OUT FOR Packing The table tries not to allocate huge chunks of screen real estate if you ask it for a lot of rows and columns. You can always stretch out the frame or explicitly tell it how big it can be. If you want to stretch the table, remember to pack it with fill both and expand on, or with grid, give it -sticky news and configure the grid row and column for some weighting. Array The array (actually a perl hash in the perltk implementation) elements for the table are of the form $array{"2,3"} etc. Make sure there are no spaces around the ','. Negative indices are allowed. Editing If you can't edit, remember that the focus model in tk is explicit, so you need to click on the table or give it the focus command. Just having a selected cell is not the same thing as being able to edit. You also need the editing cursor. If you can't get the cursor, make sure that you actually have a variable assigned to the table, and that the "state" of the cell is not disabled. COMMENTS, BUGS, etc. * Please can you send comments and bug reports to the current maintainer and their best will be done to address them. * If you find a bug, a short piece of Perl Code that exercises it would be very useful, or even better, compile with debugging and specify where it crashed in that short piece of Code. Tk-TableMatrix-1.23/TableMatrix.pm0100775002141500001300000006414710550772123016317 0ustar cerneydbteam# This file converted to perltk using the tcl2perl script and much hand-editing. # jc 6/26/00 # # table.tcl -- # # version align with tkTable 2.7, jeff.hobbs@acm.org # This file defines the default bindings for Tk table widgets # and provides procedures that help in implementing those bindings. # #-------------------------------------------------------------------------- # tkPriv elements used in this file: # # afterId - Token returned by "after" for autoscanning. # tablePrev - The last element to be selected or deselected # during a selection operation. # mouseMoved - Boolean to indicate whether mouse moved while # the button was pressed. # borderInfo - Boolean to know if the user clicked on a border # borderB1 - Boolean that set whether B1 can be used for the # interactiving resizing #-------------------------------------------------------------------------- ## Interactive cell resizing, affected by -resizeborders option ## package Tk::TableMatrix; use AutoLoader; use Carp; use strict; use vars( '%tkPriv', '$VERSION'); $VERSION = '1.23'; use Tk qw( Ev ); use base qw(Tk::Widget); Construct Tk::Widget 'TableMatrix'; bootstrap Tk::TableMatrix; sub Tk_cmd { \&Tk::tablematrix }; sub Tk::Widget::ScrlTableMatrix { shift->Scrolled('TableMatrix' => @_) } Tk::Methods("activate", "bbox", "border", "cget", "clear", "configure", "curselection", "curvalue", "delete", "get", "rowHeight", "hidden", "icursor", "index", "insert", "postscript", "reread", "scan", "see", "selection", "set", "spans", "tag", "validate", "version", "window", "colWidth", "xview", "yview"); use Tk::Submethods ( 'border' => [qw(mark 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)], ); sub ClassInit { my ($class,$mw) = @_; $tkPriv{borderB1} = 1; # initialize borderB1 $mw->bind($class,'<3>', sub { my $w = shift; my $Ev = $w->XEvent; ## You might want to check for cell returned if you want to ## restrict the resizing of certain cells $w->border('mark',$Ev->x,$Ev->y); } ); $mw->bind($class,'',['border','dragto',Ev('x'),Ev('y')]); $mw->bind($class,'<1>', sub { my $w = shift; my $Ev = $w->XEvent; $w->Button1($Ev->x,$Ev->y); } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->B1Motion($Ev->x,$Ev->y); } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $tkPriv{borderInfo} = ""; if ($w->exists) { $w->CancelRepeat; $w->activate('@' . $Ev->x.",".$Ev->y); } } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->BeginExtend( $w->index('@' . $Ev->x.",".$Ev->y)); } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->BeginToggle($w->index('@' . $Ev->x.",".$Ev->y)); } ); $mw->bind($class,'','CancelRepeat'); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; if( !$tkPriv{borderInfo} ){ $tkPriv{x} = $Ev->x; $tkPriv{y} = $Ev->y; $w->AutoScan; } } ); $mw->bind($class,'<2>', sub { my $w = shift; my $Ev = $w->XEvent; $w->scan('mark',$Ev->x,$Ev->y); $tkPriv{x} = $Ev->x; $tkPriv{y} = $Ev->y; $tkPriv{'mouseMoved'} = 0; } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $tkPriv{'mouseMoved'} = 1 if ($Ev->x ne $tkPriv{'x'} || $Ev->y ne $tkPriv{'y'}); $w->scan('dragto',$Ev->x,$Ev->y) if ($tkPriv{'mouseMoved'}); } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->Paste($w->index('@' . $Ev->x.",".$Ev->y)) unless ($tkPriv{'mouseMoved'}); } ); ClipboardKeysyms( $mw, $class, qw/ /); ClipboardKeysyms( $mw, $class, 'Control-c', 'Control-x', 'Control-v'); ############################ $mw->bind($class,'<>', sub { my $w = shift; my $Ev = $w->XEvent; eval { $w->activate('active'); } ; } ); # Remove this if you don't want cell commit to occur on every Leave for # the table (via mouse) or FocusOut (loss of focus by table). $mw->eventAdd( qw[ <> ]); $mw->bind($class,'',['ExtendSelect',-1,0]); $mw->bind($class,'',['ExtendSelect',1,0]); $mw->bind($class,'',['ExtendSelect',0,-1]); $mw->bind($class,'',['ExtendSelect',0,1]); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->yview('scroll',-1,'pages'); $w->activate('@0,0'); } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->yview('scroll',1,'pages'); $w->activate('@0,0'); } ); $mw->bind($class,'',['xview','scroll',-1,'pages']); $mw->bind($class,'',['xview','scroll',1,'pages']); $mw->bind($class,'',['see','origin']); $mw->bind($class,'',['see','end']); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->selection('clear','all'); $w->activate('origin'); $w->selection('set','active'); $w->see('active'); } ); $mw->bind($class,'', sub { my $w = shift; my $Ev = $w->XEvent; $w->selection('clear','all'); $w->activate('end'); $w->selection('set','active'); $w->see('active'); } ); $mw->bind($class,'',['DataExtend','origin']); $mw->bind($class,'',['DataExtend','end']); $mw->bind($class,'