# Copyright 2002 Interchange Development Group (http://www.icdevgroup.org/)

# Licensed under the GNU GPL v2. See file LICENSE for details.

# $Id: row.coretag,v 1.2 2005-02-09 13:39:42 docelic Exp $

UserTag row Order width

UserTag row hasEndTag

UserTag row Interpolate

UserTag row PosNumber 1

UserTag row Version $Revision: 1.2 $

UserTag row Routine <<EOR

sub tag_column {

my($spec,$text) = @_;

my($append,$f,$i,$line,$usable);

my(%def) = qw(

width 0

spacing 1

gutter 2

wrap 1

html 0

align left

);

my(%spec) = ();

my(@out) = ();

my(@lines) = ();

$spec =~ s/\n/ /g;

$spec =~ s/^\s+//;

$spec =~ s/\s+$//;

$spec = lc $spec;

$spec =~ s/\s*=\s*/=/;

$spec =~ s/^(\d+)/width=$1/;

%spec = split /[\s=]+/, $spec;

for(keys %def) {

$spec{$_} = $def{$_} unless defined $spec{$_};

}

if($spec{'html'} && $spec{'wrap'}) {

::logError("tag_column: can't have 'wrap' and 'html' specified at same time.");

$spec{wrap} = 0;

}

if(! $spec{align} or $spec{align} !~ /^n/i) {

$text =~ s/\s+/ /g;

}

my $len = sub {

my($txt) = @_;

if (1 or $spec{html}) {

$txt =~

s{ <

(

[^>'"] +

|

".*?"

|

'.*?'

) +

>

}{}gsx;

}

return length($txt);

};

$usable = $spec{'width'} - $spec{'gutter'};

return "BAD_WIDTH" if $usable < 1;

if($spec{'align'} =~ /^[ln]/i) {

$f = sub {

$_[0] .

' ' x ($usable - $len->($_[0])) .

' ' x $spec{'gutter'};

};

}

elsif($spec{'align'} =~ /^r/i) {

$f = sub {

' ' x ($usable - $len->($_[0])) .

$_[0] .

' ' x $spec{'gutter'};

};

}

elsif($spec{'align'} =~ /^i/i) {

$spec{'wrap'} = 0;

$usable = 9999;

$f = sub { @_ };

}

else {

return "BAD JUSTIFICATION SPECIFICATION: $spec{'align'}";

}

$append = '';

if($spec{'spacing'} > 1) {

$append .= "\n" x ($spec{'spacing'} - 1);

}

if($spec{'align'} =~ /^n/i) {

@lines = split(/\r?\n/, $text);

}

elsif(is_yes($spec{'wrap'}) and length($text) > $usable) {

@lines = wrap($text,$usable);

}

elsif($spec{'align'} =~ /^i/i) {

$lines[0] = ' ' x $spec{'width'};

$lines[1] = $text . ' ' x $spec{'gutter'};

}

elsif (! $spec{'html'}) {

$lines[0] = substr($text,0,$usable);

}

foreach $line (@lines) {

push @out , &{$f}($line);

for($i = 1; $i < $spec{'spacing'}; $i++) {

push @out, '';

}

}

@out;

}

sub wrap {

my ($str, $width) = @_;

my @a = ();

my ($l, $b);

for (;;) {

$str =~ s/^ +//;

$l = length($str);

last if $l == 0;

if ($l <= $width) {

push @a, $str;

last;

}

$b = rindex($str, " ", $width - 1);

if ($b == -1) {

push @a, substr($str, 0, $width);

$str = substr($str, $width);

}

else {

push @a, substr($str, 0, $b);

$str = substr($str, $b + 1);

}

}

return @a;

}

sub {

my($width,$text) = @_;

my($col,$spec);

my(@lines);

my(@len);

my(@out);

my($i,$j,$k);

my($x,$y,$line);

$i = 0;

while( $text =~ s!\[col(?:umn)?\s+

([^\]]+)

\]

([\000-\377]*?)

\[/col(?:umn)?\] !!ix ) {

$spec = $1;

$col = $2;

$lines[$i] = [];

@{$lines[$i]} = tag_column($spec,$col);

# Discover X dimension

$len[$i] = length(${$lines[$i]}[0]);

if(defined ${$lines[$i]}[1] and ${$lines[$i]}[1] =~ /^<\s*input\s+/i) {

shift @{$lines[$i]};

}

$i++;

}

my $totlen = 0;

for(@len) { $totlen += $_ }

if ($totlen > $width) {

return " B A D R O W S P E C I F I C A T I O N - columns too wide.\n"

}

# Discover y dimension

$j = $#{$lines[0]};

for ($k = 1; $k < $i; $k++) {

$j = $#{$lines[$k]} > $j ? $#{$lines[$k]} : $j;

}

for($y = 0; $y <= $j; $y++) {

$line = '';

for($x = 0; $x < $i; $x++) {

if(defined ${$lines[$x]}[$y]) {

$line .= ${$lines[$x]}[$y];

$line =~ s/\s+$//

if ($i - $x) == 1;

}

elsif (($i - $x) > 1) {

$line .= ' ' x $len[$x];

}

else {

$line =~ s/\s+$//;

}

}

push @out, $line;

}

join "\n", @out;

}

EOR