tools/perl-5.8.0/lib/site_perl/5.8.0/sun4-solaris/Tk/Table.pm

# 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.
package Tk::Table;
use strict;

use vars qw($VERSION);
$VERSION = '3.020'; # $Id: //depot/Tk8/Tk/Table.pm#20 $

use Tk::Pretty;
use AutoLoader;
use base qw(Tk::Frame);

Construct Tk::Widget 'Table';

sub ClassInit
{
 my ($class,$mw) = @_;
 $mw->bind($class,'<Configure>',['QueueLayout',8]);
 $mw->bind($class,'<FocusIn>',  'NoOp');
 $mw->XYscrollBind($class);
 return $class;
}

sub _view
{
 my ($t,$s,$page,$a,$op,$num,$type) = @_;
 if ($op eq 'moveto')
  {
   $$s = int(@$a*$num);
  }
 else
  {
   $num *= ($page/2) if ($type eq 'pages');
   $$s += $num;
  }
 $$s = 0 if ($$s < 0);
 $t->QueueLayout(4);
}

sub xview
{
 my $t  = shift;
 $t->_view(\$t->{Left},$t->cget('-columns'),$t->{Width},@_);
}

sub yview
{
 my $t  = shift;
 $t->_view(\$t->{Top},$t->cget('-rows'),$t->{Height},@_);
}

sub FocusChildren
{
 my $t = shift;
 return () if ($t->cget('-takefocus'));
 return $t->SUPER::FocusChildren;
}

sub Populate
{
 my ($t,$args) = @_;
 $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]
                 );
 $t->{'Width'}  = [];
 $t->{'Height'} = [];
 $t->{'Row'}    = [];
 $t->{'Slave'}  = {};
 $t->{'Top'}    = 0;
 $t->{'Left'}   = 0;
 $t->{'Bottom'} = 0;
 $t->{'Right'}  = 0;
 $t->{LayoutPending} = 0;
}

sub sizeN
{
 my ($n,$a) = @_;
 my $max = 0;
 my $i = 0;
 my $sum = 0;
 while ($i < @$a && $i < $n)
  {
   my $n = $a->[$i++];
   $a->[$i-1] = $n = 0 unless (defined $n);
   $sum += $n;
  }
 $max = $sum if ($sum > $max);
 while ($i < @$a)
  {
   $sum = $sum-$a->[$i-$n]+$a->[$i];
   $max = $sum if ($sum > $max);
   $i++;
  }
 return $max;
}

sub total
{
 my ($a)   = @_;
 my $total = 0;
 my $x;
 foreach $x (@{$a})
  {
   $total += $x;
  }
 return $total;
}

sub constrain
{
 my ($sb,$a,$pixels,$fixed) = @_;
 my $n     = $$sb+$fixed;
 my $total = 0;
 my $i;
 $n = @$a if ($n > @$a);
 $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++)
  {
   $total += $a->[$i];
  }
 while ($n > $fixed)
  {
   if (($total += $a->[--$n]) > $pixels)
    {
     $n++;
     last;
    }
  }
 $$sb = $n-$fixed;
}

sub Layout
{
 my ($t)    = @_;
 return unless Tk::Exists($t);
 my $rows   = @{$t->{Row}};
 my $bw     = $t->cget(-highlightthickness);
 my $frows  = $t->cget(-fixedrows);
 my $fcols  = $t->cget(-fixedcolumns);
 my $sb     = $t->cget(-scrollbars);
 my $H      = $t->Height;
 my $W      = $t->Width;
 my $tadj   = $bw;
 my $badj   = $bw;
 my $ladj   = $bw;
 my $radj   = $bw;
 my @xs     = ($W,0,0,0);
 my @ys     = (0,$H,0,0);
 my $xsb;
 my $ysb;

 my $why   = $t->{LayoutPending};
 $t->{LayoutPending} = 0;

 if ($sb =~ /^[ns]/)
  {
   $t->{xsb} = $t->Scrollbar(-orient => 'horizontal', -command => ['xview' => $t]) unless (defined $t->{xsb});
   $xsb   = $t->{xsb};
   $xs[3] = $xsb->ReqHeight;
   if ($sb =~ /^n/)
    {
     $xs[1] = $tadj;
     $tadj += $xs[3];
    }
   else
    {
     $badj += $xs[3];
     $xs[1] = $H-$badj;
    }
  }
 else
  {
   $t->{xsb}->UnmapWindow if (defined $t->{xsb});
  }

 if ($sb =~ /[ew]$/)
  {
   $t->{ysb} = $t->Scrollbar(-orient => 'vertical', -command => ['yview' => $t]) unless (defined $t->{ysb});
   $ysb    = $t->{ysb};
   $ys[2]  = $ysb->ReqWidth;
   if ($sb =~ /w$/)
    {
     $ys[0] = $ladj;
     $ladj += $ys[2];
    }
   else
    {
     $radj += $ys[2];
     $ys[0] = $W-$radj;
    }
  }
 else
  {
   $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;

 if ($why & 49)
  {
   # 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);
  }

 if ($rows)
  {
   my $cols  = @{$t->{Width}};
   my $yhwm  = $top-$frows;
   my $xhwm  = $left-$fcols;
   my $y     = $tadj;
   my $r;
   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])
        {
         my $c;
         for ($c = 0; $c < @{$t->{Row}[$r]}; $c++)
          {
           my $s = $t->{Row}[$r][$c];
           if (defined $s)
            {
             $s->UnmapWindow;
             if ($why & 1)
              {
               my $w = $t->{Width}[$c];
               $s->ResizeWindow($w,$h);
              }
            }
          }
        }
      }
     else
      {
       my $hwm  = $left-$fcols;
       my $sh   = 0;
       my $x    = $ladj;
       my $c;
       $ys[1] = $y if ($y < $ys[1] && $r >= $frows);
       for ($c = 0; $c <$cols; $c++)
        {
         my $s = $t->{Row}[$r][$c];
         my $w = $t->{Width}[$c];
         if (($c < $left && $c >= $fcols) || ($x+$w > $W-$radj) )
          {
           if (defined $s)
            {
             $s->UnmapWindow;
             $s->ResizeWindow($w,$h) if ($why & 1);
            }
          }
         else
          {
           $xs[0] = $x if ($x < $xs[0] && $c >= $fcols);
           if (defined $s)
            {
             if ($why & 1)
              {
               $s->MoveResizeWindow($x,$y,$w,$h);
              }
             else
              {
               $s->MoveWindow($x,$y);
              }
             $s->MapWindow;
            }
           $x     += $w;
           if ($c >= $fcols)
            {
             $hwm++;
             $sh    += $w
            }
          }
        }
       $xhwm = $hwm if ($hwm > $xhwm);
       $xs[2] = $sh if ($sh > $xs[2]);
       $y     += $h;
       if ($r >= $frows)
        {
         $ys[3] += $h;
         $yhwm++;
        }
      }
    }
   $t->{Bottom} = $yhwm;
   $t->{Right}  = $xhwm;
   if (defined $xsb && $xs[2] > 0)
    {
     $xsb->MoveResizeWindow(@xs);
     $cols -= $fcols;
     if ($cols > 0)
      {
       $xsb->set($t->{Left}/$cols,$t->{Right}/$cols);
       $xsb->MapWindow;
      }
    }
   if (defined $ysb && $ys[3] > 0)
    {
     $ysb->MoveResizeWindow(@ys);
     $rows -= $frows;
     if ($rows > 0)
      {
       $ysb->set($t->{Top}/$rows,$t->{Bottom}/$rows);
       $ysb->MapWindow;
      }
    }
  }
}

sub QueueLayout
{
 my ($m,$why) = @_;
 $m->afterIdle(['Layout',$m]) unless ($m->{LayoutPending});
 $m->{LayoutPending} |= $why;
}

sub SlaveGeometryRequest
{
 my ($m,$s) = @_;
 my ($row,$col) = @{$m->{Slave}{$s->PathName}};
 my $sw = $s->ReqWidth;
 my $sh = $s->ReqHeight;
 my $sz = 0;
 if ($sw > $m->{Width}[$col])
  {
   $m->{Width}[$col] = $sw;
   $m->QueueLayout(1);
   $sz++;
  }
 if ($sh > $m->{Height}[$row])
  {
   $m->{Height}[$row] = $sh;
   $m->QueueLayout(1);
   $sz++;
  }
 if (!$sz)
  {
   $s->ResizeWindow($m->{Width}[$col],$m->{Height}[$row]);
  }
}

sub get
{
 my ($t,$row,$col) = @_;
 return $t->{Row}[$row][$col];
}

sub LostSlave
{
 my ($t,$s) = @_;
 my $info   = delete $t->{Slave}{$s->PathName};
 if (defined $info)
  {
   my ($row,$col) = @$info;
   $t->{Row}[$row][$col] = undef;
   $s->UnmapWindow;
  }
 else
  {
   $t->BackTrace('Cannot find' . $s->PathName);
  }
 $t->QueueLayout(2);
}

sub put
{
 my ($t,$row,$col,$w) = @_;
 $w = $t->Label(-text => $w) unless (ref $w);
 $t->ManageGeometry($w);
 unless (defined $t->{Row}[$row])
  {
   $t->{Row}[$row] = [];
   $t->{Height}[$row] = 0;
  }
 unless (defined $t->{Width}[$col])
  {
   $t->{Width}[$col] = 0;
  }
 my $old = $t->{Row}[$row][$col];
 if (defined $old)
  {
   $old->UnmanageGeometry;
   $t->LostSlave($old);
  }
 $t->{Row}[$row][$col] = $w;
 $t->{Slave}{$w->PathName} = [$row,$col];
 $t->SlaveGeometryRequest($w);
 $t->QueueLayout(2);
 return $old;
}

#
# configure methods
#

sub scrollbars
{
 my ($t,$v) = @_;
 if (@_ > 1)
  {
   $t->_configure(-scrollbars => $v);
   $t->QueueLayout(32);
  }
 return $t->_cget('-scrollbars');
}

sub rows
{
 my ($t,$r) = @_;
 if (@_ > 1)
  {
   $t->_configure(-rows => $r);
   $t->QueueLayout(16);
  }
 return $t->_cget('-rows');
}

sub fixedrows
{
 my ($t,$r) = @_;
 if (@_ > 1)
  {
   $t->_configure(-fixedrows => $r);
   $t->QueueLayout(16);
  }
 return $t->_cget('-fixedrows');
}

sub columns
{
 my ($t,$r) = @_;
 if (@_ > 1)
  {
   $t->_configure(-columns => $r);
   $t->QueueLayout(16);
  }
 return $t->_cget('-columns');
}

sub fixedcolumns
{
 my ($t,$r) = @_;
 if (@_ > 1)
  {
   $t->_configure(-fixedcolumns => $r);
   $t->QueueLayout(16);
  }
 return $t->_cget('-fixedcolumns');
}

1;
__END__
sub Create
{
 my $t = shift;
 my $r = shift;
 my $c = shift;
 my $kind = shift;
 $t->put($r,$c,$t->$kind(@_));
}

sub totalColumns
{
 scalar @{shift->{'Width'}};
}

sub totalRows
{
 scalar @{shift->{'Height'}};
}

sub Posn
{
 my ($t,$s) = @_;
 my $info   = $t->{Slave}{$s->PathName};
 return (wantarray) ? @$info : $info;
}

sub see
{
 my $t = shift;
 my ($row,$col) = (@_ == 2) ? @_ : @{$t->{Slave}{$_[0]->PathName}};
 my $see = 1;
 if (($row -= $t->cget('-fixedrows')) >= 0)
  {
   if ($row < $t->{Top})
    {
     $t->{Top} = $row;
     $t->QueueLayout(4);
     $see = 0;
    }
   elsif ($row >= $t->{Bottom})
    {
     $t->{Top} += ($row - $t->{Bottom}+1);
     $t->QueueLayout(4);
     $see = 0;
    }
  }
 if (($col -= $t->cget('-fixedcolumns')) >= 0)
  {
   if ($col < $t->{Left})
    {
     $t->{Left} = $col;
     $t->QueueLayout(4);
     $see = 0;
    }
   elsif ($col >= $t->{Right})
    {
     $t->{Left} += ($col - $t->{Right}+1);
     $t->QueueLayout(4);
     $see = 0;
    }
  }
 return $see;
}

=cut