# ====================================================================
# Copyright (C) 1997,1998 Stephen Farrell <stephen@farrell.org>
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# ====================================================================
# File: TLCore.pm
# Author: Stephen Farrell
# Created: August 1997
# Locations: http://www.palefire.org/~sfarrell/TableLayout/
# CVS $Id: TLCore.pm,v 1.27 1998/09/20 21:08:27 sfarrell Exp $
# ====================================================================
## TODO:
## +++. integrate with CGI.pm... i think this will make some ppl happy =)
## 1. When add something like a hidden form component into a table,
## make sure it doesn't add an (extraneous) new cell for it.
## 2. Way to tell passcgi to NOT pass a certain key; similarly way to
## blow-away a parameter. By the same token; wrt default
## parameters, it should be possible to inheret parameters from a
## given labeled class, and then add some of your own, blow some
## away, and so on.
## 5. obj2tag should also take a tag in case some people make objects
## that are expensive to create
## 7. make it so that Anchor and align collide in tl_getParameters()
## so that you can't have both inadvertantly.
## 10. BUG! If you insert a form into a containing table, you need to
## do so before you insert another table into it, otherwise the
## inner table doesn't know about the form. (maybe not a bug??,
## but a design flaw?)
## 11. cleaning up of circular references is only about 90% now--need
## to get *all* of them (project for a rainy day =)
## 12. should be able to insert default preferences for children at
## any widget level. implement default parameters on top of
## getAllChildren(). keep api backwards compatible, but allow
## setting of def params for any component container.
##
## DONE
## o fixed textarea
## o any componentcontainer can contain a form.
## o multi form components can take flag 'Default', which will do the
## same as useData() on the form
##
use Carp;
use strict;
##
## 1998/04/20 1:14pm default constructor--move specific processing
## into tl_init()
##
sub new {
my $this = {};
bless $this, shift;
$this->tl_init(@_);
return $this;
}
sub tl_init { confess "cannot resurrect the dead" if shift->{WAS_DESTROYED} }
##
## tl_getParameters(): this is used internally to generate the
## parameters list. It combines the parameters set as global with
## those entered with the constructor for this object. Note that
## tl_getParameters needs to be called "late" (like in tl_setup(), but
## not in insert()).
##
## You'll find you need to override this when you have "fake"
## parameters you're injecting (look at
## HTML::TableLayout::Component::Text for an example)
##
sub tl_getParameters {
my ($this) = @_;
confess "No WINDOW" unless $this->{TL_WINDOW};
my %gp = $this->{TL_WINDOW}->{PARAMETERS}->get($this);
if ($this->{TL_PARAMS}) {
my %h = (%gp, %{ $this->{TL_PARAMS} });
return %h;
}
else {
return %gp;
}
}
##
## getParameter( param_name ): get a particular parameter from a
## component. if there is a window, then it'll call
## tl_getParameters() to get defaults, otherwise it returns just
## whatever is in the TL_PARAMS hash
##
sub getParameter {
my $this = shift;
my $param = shift;
my %p =
($this->{TL_WINDOW}) ? $this->tl_getParameters() : %{ $this->{TL_PARAMS} };
return (exists $p{$param}) ? $p{$param} : undef;
}
##
## tl_getLocalParameters(): This gets you a reference, so you can
## delete, insert, hang yourself, etc.
##
sub tl_getLocalParameters { return shift->{TL_PARAMS} }
##
## tl_inheritParamsFrom(): This is here for widgets to be able to
## inherit default properties from whatever they wish. For example,
## if you make a widget that derives from Cell, you might want to make
## it get the default parameters for cell as well. Just call
## tl_inheritParamsFrom(cell()) "early" and that'll happen for you.
##
## Warning: this method might go away in a future release.
sub tl_inheritParamsFrom {
my ($this, $obj) = @_;
$this->{TL_PARAMS_ISA} = $obj;
}
##
## setParams() takes a hash and sets the params hash
## accordingly... this is used when you want to change such AFTER the
## constructor is called (the normal place for doing so).
##
sub setParams {
my ($this, %params) = @_;
foreach ( keys %params ) {
$this->{TL_PARAMS}->{$_} = $params{$_};
}
return $this;
}
##
## need to add explicit memory management here
##
sub tl_destroy {
my ($this) = @_;
undef $this->{TL_PARAMS};
undef $this->{TL_PARAMS_ISA};
$this->{WAS_DESTROYED} = 1;
## warn "DESTROY $this\n";
}
##
## whip up a copy of an object--note this is a first attempt...
##
sub clone {
my ($this) = @_;
##
## do this??
##
delete $this->{TL_WINDOW};
delete $this->{TL_CONTAINER};
delete $this->{TL_FORM};
my $d = Data::Dumper->new([$this],[qw(enolc)]);
$d->Purity(1);
$d->Deepcopy(1);
my $enolc;
eval $d->Dump();
return $enolc;
}
##
## accessors -- these only work in tl_setup(), not tl_init()!
##
sub getForm { return shift->{TL_FORM} }
sub getContainer { return shift->{TL_CONTAINER} }
sub getWindow { return shift->{TL_WINDOW} }
## sub DESTROY { warn "DESTROYING " . shift . "\n" }
## --------------------------------------------------------------------
##
## Parameters package--this handles the default parameters
##
@HTML::TableLayout::Parameters::ISA=qw(HTML::TableLayout::TL_BASE);
sub tl_init {
my $this = shift;
$this->{DATA} = shift;
$this->SUPER::tl_init(@_);
}
##
## FAST & destructive
##
sub set {
my ($this, $obj, %hash) = @_;
$this->{DATA}->{$this->_obj2tag($obj)} = \%hash;
}
##
## SLOW & non-destructive
##
sub insert {
my ($this, $obj, %hash) = @_;
foreach (keys %hash) {
$this->{DATA}->{$this->_obj2tag($obj)}->{$_} = $hash{$_};
}
}
sub delete {
my ($this, @keys) = @_;
map { delete $this->{DATA}->{$_} } @keys;
}
sub get {
my ($this, $obj) = @_;
my $h = $this->{DATA}->{$this->_obj2tag($obj)};
if ($h) {
return %$h;
}
else {
return ();
}
}
##
## This is here b/c when you create new widgets yourself, they can
## take advantage of the default parameters system without having to
## add any code yourself to the widget to handle this specifically.
## In order to do this, the way it relates defaults with classes is by
## being given an instance of the class, and then it "recognizes" that
## class in the future.
##
sub _obj2tag {
my ($this, $obj) = @_;
##
## when you make a widget, you might want to be able to inheret the
## params as if you were the same kind of hting. You can call
## $this->tl_inheritParamsFrom(constructor) and you're set.
##
my $name = $obj->{TL_PARAMS_ISA} || $obj;
my $tag;
##
## _obj2tag() is called a lot, so this regexp is a bit expensive...
##
($tag = $name) =~ s/^([\w:]+)=.*/$1/;
return $tag;
}
# ---------------------------------------------------------------------
@HTML::TableLayout::_Anchor::ISA=qw(HTML::TableLayout::TL_BASE);
sub tl_init {
my $this = shift;
$this->{anchor} = shift;
$this->SUPER::tl_init(@_);
}
sub value {
my ($this) = @_;
SWITCH: {
my $case = $this->{anchor} || return ();
($case eq "top") and return (valign=>"top");
($case eq "right") and return (align=>"right");
($case eq "bottom") and return (valign=>"bottom");
($case eq "left") and return (align=>"left");
($case eq "center") and return (align=>"center" ,valign=>"middle");
($case eq "ne") and return (align=>"right" ,valign=>"top");
($case eq "se") and return (align=>"right" ,valign=>"bottom");
($case eq "sw") and return (align=>"left" ,valign=>"bottom");
($case eq "nw") and return (align=>"left" ,valign=>"top");
($case =~ /^n/) and return (align=>"center" ,valign=>"top");
($case =~ /^e/) and return (align=>"right" ,valign=>"center");
($case =~ /^s/) and return (align=>"center" ,valign=>"bottom");
($case =~ /^w/) and return (align=>"left" ,valign=>"center");
die("unknown anchor \"$case\"");
}
}
# ---------------------------------------------------------------------
@HTML::TableLayout::Window::ISA=qw(HTML::TableLayout::ComponentContainer);
sub tl_init {
my $this = shift;
my $def_params = shift;
my $title = shift;
my %params = @_;
$this->SUPER::tl_init(@_);
## FIXME -- what does this do?
defined $params{Cacheable} and $this->{CACHEABLE} = 1;
delete $params{Cacheable};
if ($def_params) {
$this->{PARAMETERS} = $def_params;
}
else {
##
## you can pass in null parameters and everything will behave
## properly, but just defaults
##
$this->{PARAMETERS} = HTML::TableLayout::Parameters->new();
}
$this->{title} = $title;
$this->{headers} = [];
$this->{tables} = [];
$this->{scripts} = [];
$this->{TL_WINDOW} = $this; # these get cleaned up by SUPER::tl_destroy
$this->{TL_CONTAINER} = $this;
$this->{INDENT} = 0;
$this->{CACHEABLE} = 0;
}
sub tl_destroy {
my $this = shift;
$this->{PARAMETERS}->tl_destroy();
undef $this->{PARAMETERS};
foreach (@{ $this->{headers} }) { $_->tl_destroy() }
foreach (@{ $this->{tables} }) { $_->tl_destroy() }
foreach (@{ $this->{scripts} }) { $_->tl_destroy() }
$this->SUPER::tl_destroy();
}
sub insert {
my ($this, $component) = @_;
##
## Sanity checking on input (this is a bit broken, of course--is
## there an equivalent for "ref" that checks for object's classes?
##
ref $component or die("$component must be an object");
$component->isa("HTML::TableLayout::Component") or
die("$component must be a component");
##
## Pseudo (runtime) overloading...
##
if ($component->isa("HTML::TableLayout::Script")) {
push @{ $this->{scripts} }, $component;
}
elsif ($component->isa("HTML::TableLayout::WindowHeader")) {
push @{ $this->{headers} }, $component;
}
elsif ($component->isa("HTML::TableLayout::Table")) {
push @{ $this->{tables} }, $component;
}
else {
die("cannot insert a $component into a window");
}
$this->SUPER::insert($component);
}
sub render {
my $this = shift;
$this->print();
$this->tl_destroy();
}
sub print {
my ($this) = @_;
##
## Fire off the first traversal of the heirarchy where "setup" gets
## done. This is where componentcontainers tell their components
## their context, and where things that need to know about or affect
## other things around them can do so.
##
$this->tl_setup();
print "Content-type: text/html\n\n";
$this->i_print("<HTML");
$this->_indentIncrement();
$this->i_print("><HEAD><TITLE>$this->{title}</TITLE></HEAD");
foreach (@{ $this->{scripts} }) { $_->tl_print() }
$this->i_print("><BODY".params($this->tl_getParameters())."");
$this->_indentIncrement();
foreach (@{ $this->{headers} }) { $_->tl_print() }
foreach (@{ $this->{tables} }) { $_->tl_print() }
$this->_indentDecrement();
$this->i_print("></BODY");
$this->_indentDecrement();
$this->i_print("></HTML>");
$this->i_print();
}
sub toString {
my ($this) = @_;
$this->{CACHEABLE} = 1;
$this->print();
return $this->{TEXT_CACHE};
}
##
## i_print() and f_print() are what components/widgets use to print
## themselves out. When you use these, you're guaranteed to get at
## least two things for free: (1) proper indenting of code (as long as
## you do NOT use any newlines) (2) correct behavior depending on
## whether we call print() or toString() on the window. I.E., you do
## not *need* to use these in your widgets, as long as you accept the
## aforementioned losses (and perhaps others in the future...
##
##
## i_print(): indent print (both i_print() and f_print() take care of
## whether to pack the result into a string or output it right away
## with print())
##
sub i_print {
my ($this,$text) = @_;
my $cacheable = $this->{CACHEABLE};
my $i;
my $indent = $this->{INDENT};
##
## This is the only place where newlines come from!
##
$cacheable ? $this->{TEXT_CACHE} .= "\n" : print "\n";
##
## print the indent spaces so it looks pretty
##
if ($cacheable) {
$this->{TEXT_CACHE} .= " " x $indent;
}
else {
print " " x $indent;
}
##
## print the content
##
if ($cacheable) {
if ($text) {
$this->{TEXT_CACHE} ||= "";
$this->{TEXT_CACHE} .= $text;
}
}
else {
print $text;
}
}
##
## f_print(): flush print
##
sub f_print {
my ($this,$text) = @_;
if ($this->{CACHEABLE}) {
$this->{TEXT_CACHE} .= $text;
}
else {
print $text;
}
}
sub _indentIncrement { shift->{INDENT}++ }
sub _indentDecrement { shift->{INDENT}-- }
sub _getIndent { return shift->{INDENT} }
sub _incrementNumForms { shift->{NUM_FORMS}++ }
sub _getNumForms { return shift->{NUM_FORMS} || 0 }
# ---------------------------------------------------------------------
use Carp;
@HTML::TableLayout::Table::ISA=qw(HTML::TableLayout::ComponentContainer);
sub tl_init {
my $this = shift;
$this->SUPER::tl_init(@_);
$this->{rowindex} = 0;
}
sub tl_destroy {
my $this = shift;
undef $this->{rowindex};
foreach (0.. $#{ $this->{rows} }) {
$this->{rows}->[$_]->tl_destroy();
undef $this->{rows}->[$_];
}
undef $this->{rows};
$this->SUPER::tl_destroy();
}
sub insert {
my ($this, $c, $br) = @_;
if (! ref $c) {
my $temp = $c;
$c = HTML::TableLayout::Cell->new();
$c->insert($temp,$br);
}
$this->SUPER::insert($c, $br);
}
sub tl_setup {
my ($this) = @_;
$this->tl_setup_form();
my $first_row = 1;
my $i;
foreach $i (0..$#{ $this->{TL_COMPONENTS} }) {
##
## We can use $c for the most part, unless we are instrumenting a
## change in what one of the components actually is.
##
my $c = $this->{TL_COMPONENTS}->[$i];
my $cell;
if ($c->isa("HTML::TableLayout::Cell")) {
##
## if the cell has a header, then we slam it into an embedded
## table. this procedure is too complex, and this code should
## probably be encapsulated elsewhere, or made simpler.
##
my $h;
if ($h = $c->getHeader()) {
$c->_forgetIHaveAHeader();
##
## lie to the header about its context so we can ask it for
## it's orientation here. But we mean well... so it's ok.
## Plus it'll get the correct context in a bit.
##
$h->tl_setContext($this);
my ($t, $o);
$o = $h->orientation();
##
## Replace, in the components array, the original cell with a
## new one that contains it (and its header) in a table.
##
$this->{TL_COMPONENTS}->[$i] = $cell
= HTML::TableLayout::Cell->new(Anchor=>$o);
##
## $cell needs to inherit params from $c, $c needs to be
## cleaned of most (all?) parameters.
##
## FIXME--there is no way this is fully correct...
##
if (exists $c->{TL_PARAMS}->{colspan}) {
$cell->{TL_PARAMS}->{colspan} = $c->{TL_PARAMS}->{colspan};
delete $c->{TL_PARAMS}->{colspan};
}
if (exists $c->{TL_PARAMS}->{rowspan}) {
$cell->{TL_PARAMS}->{rowspan} = $c->{TL_PARAMS}->{rowspan};
delete $c->{TL_PARAMS}->{rowspan};
}
$cell->insert($t=HTML::TableLayout::Table
->new(width=>"100%",
height=>"100%",
columns=>($o eq "top" or
$o eq "bottom") ? 1 : 2));
if ($o eq "top" or $o eq "left") {
$t->insert($h); # $h gets correct context here...
$t->insert($c);
}
else {
$t->insert($c);
$t->insert($h); # ...or here.
}
}
else {
$this->{TL_COMPONENTS}->[$i] = $cell = $c;
}
}
else {
$this->{TL_COMPONENTS}->[$i] = $cell =
HTML::TableLayout::Cell->new()->insert($c);
}
##
## ...now we have a cell for sure.
##
$cell->tl_setContext($this);
## =================================================================
## o Pack resulting Cells into Table
## =================================================================
##
## Take care of adding it to the row
##
my $row;
if ($first_row) {
$first_row = 0;
##
## Bootstrap the first row
##
$row = $this->{rows}->[0]
= HTML::TableLayout::_Row->new($this,
$this->{TL_WINDOW},
$this->{TL_FORM});
$row->insert($cell) or confess "insert failed; colspan > columns ??";
}
elsif (($row = $this->{rows}->[$this->{rowindex}])->insert($cell)) {
##
## Ok--successfully added cell to current row
##
}
else {
##
## Hmm... need to create a new row (ok)
##
$this->_removeOldSpanningCells();
my $n_ridx = ++$this->{rowindex};
$row = $this->{rows}->[$n_ridx]
= HTML::TableLayout::_Row->new($this,
$this->{TL_WINDOW},
$this->{TL_FORM});
if (! $row->insert($cell)) {
##
## This is error condition (!)
##
my $cs = $cell->getColspan();
my $cols = $this->getColumns();
if ($cs > $cols) {
confess "colspan [$cs] exceeds max number of columns [$cols]";
}
else {
confess "?? cannot pack; colspan [$cs] and cols [$cols]";
}
}
}
$cell->tl_setup();
}
}
sub tl_print {
my ($this) = @_;
my $w = $this->{TL_WINDOW};
my $p = params($this->tl_getParameters()) || "";
$w->i_print("><TABLE $p");
if ($this->{form_is_mine}) { $this->{TL_FORM}->tl_print() }
$w->_indentIncrement();
foreach(@{ $this->{rows} }) { $_->tl_print() };
$w->_indentDecrement();
if ($this->{form_is_mine}) { $this->{TL_FORM}->_print_end() }
$w->i_print("></TABLE");
}
sub getColumns { return shift->{TL_PARAMS}->{columns} || 1 }
sub setColumns { shift->{TL_PARAMS}->{columns} = pop }
##
## A "spanning cell" is a cell having a colspan > 1 and as such is
## pertinent while packing subsequent rows. It needs to be handled
## explicitely since it affects how many cells will fit into later
## rows. These functions are used to keep track of cells in this
## state, and do appropriate calculations and removing of old or stale
## "spanning cells".
##
sub _insertSpanningCell {
my ($this, $cell) = @_;
push @{ $this->{spanning_cells} },
HTML::TableLayout::_SpanningCell->new($cell,
$this->{TL_WINDOW},
$this->{TL_FORM})
}
sub _colspanOfSpanningCells {
my ($this) = @_;
my $sum = 0;
my $sc;
foreach $sc (@{ $this->{spanning_cells} }) {
$sum += $sc->getColspan();
}
return $sum;
}
sub _removeOldSpanningCells {
my ($this) = @_;
my @old = @{ $this->{spanning_cells} };
my (@new, $sc);
foreach $sc (@old) {
if ($sc->decrement() > 0) {
push @new, $sc;
}
}
$this->{spanning_cells} = \ @new;
}
# ---------------------------------------------------------------------
@HTML::TableLayout::_Row::ISA=qw(HTML::TableLayout::ComponentContainer);
##
## Some things about rows:
##
## o Rows happen automagically, hence the _ (aka private)
##
## o note that there are no parameters for the row--everyting that can
## be set in the row can also be set in the cell (<TD>), so that's
## where it'll be set.
##
## o We don't have to worry about the timing of rows b/c they are not
## created until the table is "setup", which is "late". Hence we
## can set up the context directly in the constructor.
##
sub tl_init {
my $this = shift;
$this->{TL_CONTAINER} = shift;
$this->{TL_WINDOW} = shift;
$this->{TL_FORM} = shift;
$this->{columns} = $this->{TL_CONTAINER}->getColumns();
$this->SUPER::tl_init(@_);
}
sub tl_destroy {
my $this = shift;
undef $this->{columns};
$this->SUPER::tl_destroy();
}
sub setRSOffset { shift->{rs_offset} = pop }
sub getRSOffset { return shift->{rs_offset} || 0 }
sub getVacantSlots {
my ($this) = @_;
my $spaces = $this->{columns};
my $cs_effect = sum(map { $_->getColspan() } @{ $this->{TL_COMPONENTS} });
my $rs_effect = $this->{TL_CONTAINER}->_colspanOfSpanningCells();
my $rs_offset = $this->getRSOffset();
my $filled = $cs_effect + $rs_effect - $rs_offset;
return $spaces - $filled;
}
sub isFull { return shift->getVacantSlots() <= 0 }
##
## this insert() returns 1 if it is able to insert the cell, and 0 if
## it is not. In most cases, returning 0 is normal--it's just time to
## create a new row.
##
sub insert {
my ($this, $cell) = @_;
return 0 if ($this->getVacantSlots() - $cell->getColspan() < 0);
if ($cell->tl_getContainer() ne $this) {
$cell->tl_setContext($this);
}
if ($cell->getRowspan() > 1) {
$this->{TL_CONTAINER}->_insertSpanningCell($cell);
$this->setRSOffset($this->getRSOffset()+$cell->getColspan());
}
$this->SUPER::insert($cell);
}
sub tl_print {
my ($this) = @_;
##
## The following check is disabled, but it *might* be re-enabled in
## the future. The impact would be that the table must be CORRECTLY
## filled or else this will layoutmanager will die(). Perhaps there
## will be a flag to set for this behavior.
##
#if (! $this->isFull() ) { die("row is not full") }
my $w = $this->{TL_WINDOW};
$w->i_print("><TR");
$w->_indentIncrement();
foreach(@{ $this->{TL_COMPONENTS} }) { $_->tl_print() };
$w->_indentDecrement();
$w->i_print("></TR");
}
# ---------------------------------------------------------------------
@HTML::TableLayout::Cell::ISA=qw(HTML::TableLayout::ComponentContainer);
sub tl_destroy {
my $this = shift;
undef $this->{cell_header};
$this->SUPER::tl_destroy();
}
sub tl_getParameters {
my ($this) = @_;
my %r = ($this->{TL_WINDOW}->{PARAMETERS}->get($this),
%{ $this->{TL_PARAMS} },
colspan=>$this->getColspan(),
rowspan=>$this->getRowspan(),
width=>$this->getWidth());
return %r;
}
sub insert {
my ($this, $c, $br) = @_;
##
## if $c is a header, need to treat specially
##
if (ref $c) {
if ($c->isa("HTML::TableLayout::CellHeader")) {
if ($this->{"cell_header"}) {
die("There can only be one header per cell | $this");
}
$this->{"cell_header"} = $c;
}
elsif ($c->isa("HTML::TableLayout::Cell")) {
die("Cannot insert a cell into a cell!");
}
else {
$this->SUPER::insert($c, $br);
}
}
else {
$this->SUPER::insert($c, $br);
}
return $this;
}
sub tl_print {
my ($this) = @_;
my $w = $this->{TL_WINDOW};
##
## if "form_is_mine" flag is set, then we know we contain a form,
## and that this form should be printed AND IT HAS NOT ALREADY BEEN
## PRINTED BY A CONTAINING OBJECT.
##
$this->{form_is_mine} and $this->{TL_FORM}->tl_print();
$w->i_print("><TD".params($this->tl_getParameters())."");
$w->_indentIncrement();
foreach (0..$#{ $this->{TL_COMPONENTS} }) {
$this->{TL_COMPONENTS}->[$_]->tl_print();
$this->{TL_BREAKS}->[$_] and $w->i_print("><BR");
}
$w->_indentDecrement();
$w->i_print("></TD");
$this->{form_is_mine} and $this->{TL_FORM}->_print_end();
}
sub getWidth {
my ($this) = @_;
return $this->{TL_PARAMS}->{width} ||
int(100 * ($this->getColspan() /
$this->{TL_CONTAINER}->{TL_CONTAINER}->getColumns())) . "%";
}
sub getColspan { return shift->{TL_PARAMS}->{colspan} || 1 }
sub getRowspan { return shift->{TL_PARAMS}->{rowspan} || 1 }
sub getForm { return shift->{TL_FORM} }
sub getHeader { return shift->{"cell_header"} }
sub setColspan { shift->{TL_PARAMS}->{colspan} = pop }
sub setRowspan { shift->{TL_PARAMS}->{rowspan} = pop }
sub _forgetIHaveAHeader { delete shift->{"cell_header"} }
# ---------------------------------------------------------------------
@HTML::TableLayout::_SpanningCell::ISA=qw(HTML::TableLayout::TL_BASE);
##
## Like rows, these happen "late" and so we can put the context info
## right in the constructor
##
sub tl_init {
my $this = shift;
$this->{TL_CONTAINER} = shift;
$this->{size} = $this->{TL_CONTAINER}->getRowspan();
$this->{TL_WINDOW} = shift;
$this->{TL_FORM} = shift;
$this->SUPER::tl_init(@_);
}
sub decrement { return --shift->{size} }
sub increment { return ++shift->{size} }
sub getColspan { return shift->{TL_CONTAINER}->getColspan() }
# ---------------------------------------------------------------------
@HTML::TableLayout::CellHeader::ISA
=qw(HTML::TableLayout::ComponentContainer HTML::TableLayout::Cell);
##
## The inheretence is kind of whack here. Basically, this thing sits
## in a table and hence should be a cell. HOWEVER, we don't want to
## use cell's tl_getParameters(), but rather the one from
## Component... funny thing is that cell is a component, so by using
## multiple inheretence here, we're a cell and twice a component. but
## it seems to work so what the fuck^H^H^H^Hfooey.
##
sub tl_init {
my $this = shift;
my $h = shift;
$this->SUPER::tl_init(@_);
if (ref $h) {
$this->{TL_COMPONENTS}->[0] = $h;
}
else {
$this->{TL_COMPONENTS}->[0]
= HTML::TableLayout::Component::Text->new($h);
}
}
sub tl_print {
my ($this) = @_;
my $w = $this->{TL_WINDOW};
my %params = $this->tl_getParameters();
delete $params{Orientation};
$w->i_print("><TH".params(%params)."");
$w->_indentIncrement();
$this->{TL_COMPONENTS}->[0]->tl_print();
$w->_indentDecrement();
$w->i_print("></TH");
}
##
## Note that "Orientation" is capitalized because it is a pseudo
## parameter and does not make it through to the HTML.
##
sub orientation {
my ($this) = @_;
my %p = $this->tl_getParameters();
return $p{Orientation} || "top";
}
# ---------------------------------------------------------------------
@HTML::TableLayout::WindowHeader::ISA=
qw(HTML::TableLayout::ComponentContainer);
sub tl_init {
my $this = shift;
$this->{H} = shift;
my $xx = shift;
$this->SUPER::tl_init(@_);
$this->{TL_COMPONENTS}->[0] = $xx;
}
sub tl_setup {
my ($this) = @_;
if (! ref $this->{TL_COMPONENTS}->[0]) {
$this->{TL_COMPONENTS}->[0] =
HTML::TableLayout::Component::Text->new($this->{TL_COMPONENTS}->[0]);
}
$this->SUPER::tl_setup();
}
sub tl_print {
my ($this) = @_;
my $w = $this->{TL_WINDOW};
if ($this->{H}) {
$w->i_print("><H".$this->{H}.params($this->tl_getParameters())."");
$w->_indentIncrement();
$this->{TL_COMPONENTS}->[0]->tl_print();
$w->_indentDecrement();
$w->f_print("></H$this->{H}");
}
else {
$w->i_print();
$this->{TL_COMPONENTS}->[0]->tl_print();
}
}
# ---------------------------------------------------------------------
@HTML::TableLayout::Script::ISA=qw(HTML::TableLayout::Component);
sub tl_init {
my $this = shift;
$this->{script} = shift;
$this->SUPER::tl_init(@_);
}
sub tl_print {
my ($this) = @_;
my $w = $this->{TL_WINDOW};
my $p = params($this->tl_getParameters()) || "";
$w->i_print("><SCRIPT $p>\n<!--\n");
$w->f_print($this->{"script"});
$w->f_print("\n//-->");
$w->i_print("</SCRIPT");
}
1;