# Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
$VERSION = '3.020'; # $Id: //depot/Tk8/Tk/Table.pm#20 $
Construct Tk
::Widget
'Table';
$mw->bind($class,'<Configure>',['QueueLayout',8]);
$mw->bind($class,'<FocusIn>', 'NoOp');
$mw->XYscrollBind($class);
my ($t,$s,$page,$a,$op,$num,$type) = @_;
$num *= ($page/2) if ($type eq 'pages');
$t->_view(\
$t->{Left
},$t->cget('-columns'),$t->{Width
},@_);
$t->_view(\
$t->{Top
},$t->cget('-rows'),$t->{Height
},@_);
return () if ($t->cget('-takefocus'));
return $t->SUPER::FocusChildren
;
$t->SUPER::Populate
($args);
$t->ConfigSpecs('-scrollbars' => [METHOD
=> 'scrollbars','Scrollbars','nw'],
'-takefocus' => [SELF
=> 'takeFocus','TakeFocus',1],
'-rows' => [METHOD
=> 'rows','Rows',10],
'-fixedrows' => [METHOD
=> 'fixedRows','FixedRows',0],
'-columns' => [METHOD
=> 'columns','Columns',10],
'-fixedcolumns' => [METHOD
=> 'fixedColumn','FixedColumns',0],
'-highlightthickness' => [SELF
=> 'highlightThickness','HighlightThickness',2]
while ($i < @
$a && $i < $n)
$a->[$i-1] = $n = 0 unless (defined $n);
$max = $sum if ($sum > $max);
$sum = $sum-$a->[$i-$n]+$a->[$i];
$max = $sum if ($sum > $max);
my ($sb,$a,$pixels,$fixed) = @_;
$n = $fixed if ($n < $fixed);
for ($i= 0; $i < $fixed; $i++)
(defined($a->[$i])) && ($total += $a->[$i]);
for ($i=$n; $total < $pixels && $i < @
$a; $i++)
if (($total += $a->[--$n]) > $pixels)
return unless Tk
::Exists
($t);
my $bw = $t->cget(-highlightthickness
);
my $frows = $t->cget(-fixedrows
);
my $fcols = $t->cget(-fixedcolumns
);
my $sb = $t->cget(-scrollbars
);
my $why = $t->{LayoutPending
};
$t->{xsb
} = $t->Scrollbar(-orient
=> 'horizontal', -command
=> ['xview' => $t]) unless (defined $t->{xsb
});
$xs[3] = $xsb->ReqHeight;
$t->{xsb
}->UnmapWindow if (defined $t->{xsb
});
$t->{ysb
} = $t->Scrollbar(-orient
=> 'vertical', -command
=> ['yview' => $t]) unless (defined $t->{ysb
});
$t->{ysb
}->UnmapWindow if (defined $t->{ysb
});
constrain
(\
$t->{Top
}, $t->{Height
},$H-($tadj+$badj),$frows);
constrain
(\
$t->{Left
},$t->{Width
}, $W-($ladj+$radj),$fcols);
my $top = $t->{Top
}+$frows;
my $left = $t->{Left
}+$fcols;
# Width and/or Height of element or
# number of rows and/or columns or
# scrollbar presence has changed
my $w = sizeN
($t->cget('-columns'),$t->{Width
})+$radj+$ladj;
my $h = sizeN
($t->cget('-rows'),$t->{Height
})+$tadj+$badj;
$t->GeometryRequest($w,$h);
my $cols = @
{$t->{Width
}};
for ($r = 0; $r < $rows; $r++)
my $h = $t->{Height
}[$r];
if (($r < $top && $r >= $frows) || ($y+$h > $H-$badj))
if (defined $t->{Row
}[$r])
for ($c = 0; $c < @
{$t->{Row
}[$r]}; $c++)
my $s = $t->{Row
}[$r][$c];
$ys[1] = $y if ($y < $ys[1] && $r >= $frows);
for ($c = 0; $c <$cols; $c++)
my $s = $t->{Row
}[$r][$c];
if (($c < $left && $c >= $fcols) || ($x+$w > $W-$radj) )
$s->ResizeWindow($w,$h) if ($why & 1);
$xs[0] = $x if ($x < $xs[0] && $c >= $fcols);
$s->MoveResizeWindow($x,$y,$w,$h);
$xhwm = $hwm if ($hwm > $xhwm);
$xs[2] = $sh if ($sh > $xs[2]);
if (defined $xsb && $xs[2] > 0)
$xsb->MoveResizeWindow(@xs);
$xsb->set($t->{Left
}/$cols,$t->{Right}/$cols);
if (defined $ysb && $ys[3] > 0)
$ysb->MoveResizeWindow(@ys);
$ysb->set($t->{Top
}/$rows,$t->{Bottom}/$rows);
$m->afterIdle(['Layout',$m]) unless ($m->{LayoutPending
});
$m->{LayoutPending
} |= $why;
my ($row,$col) = @
{$m->{Slave
}{$s->PathName}};
if ($sw > $m->{Width
}[$col])
if ($sh > $m->{Height
}[$row])
$m->{Height
}[$row] = $sh;
$s->ResizeWindow($m->{Width
}[$col],$m->{Height
}[$row]);
return $t->{Row
}[$row][$col];
my $info = delete $t->{Slave
}{$s->PathName};
$t->{Row
}[$row][$col] = undef;
$t->BackTrace('Cannot find' . $s->PathName);
my ($t,$row,$col,$w) = @_;
$w = $t->Label(-text
=> $w) unless (ref $w);
unless (defined $t->{Row
}[$row])
unless (defined $t->{Width
}[$col])
my $old = $t->{Row
}[$row][$col];
$t->{Row
}[$row][$col] = $w;
$t->{Slave
}{$w->PathName} = [$row,$col];
$t->SlaveGeometryRequest($w);
$t->_configure(-scrollbars
=> $v);
return $t->_cget('-scrollbars');
$t->_configure(-rows
=> $r);
return $t->_cget('-rows');
$t->_configure(-fixedrows
=> $r);
return $t->_cget('-fixedrows');
$t->_configure(-columns
=> $r);
return $t->_cget('-columns');
$t->_configure(-fixedcolumns
=> $r);
return $t->_cget('-fixedcolumns');
$t->put($r,$c,$t->$kind(@_));
scalar @
{shift->{'Width'}};
scalar @
{shift->{'Height'}};
my $info = $t->{Slave
}{$s->PathName};
return (wantarray) ? @
$info : $info;
my ($row,$col) = (@_ == 2) ?
@_ : @
{$t->{Slave
}{$_[0]->PathName}};
if (($row -= $t->cget('-fixedrows')) >= 0)
elsif ($row >= $t->{Bottom
})
$t->{Top
} += ($row - $t->{Bottom
}+1);
if (($col -= $t->cget('-fixedcolumns')) >= 0)
elsif ($col >= $t->{Right
})
$t->{Left
} += ($col - $t->{Right
}+1);