view release on metacpan or  search on metacpan

HTML/Handler.pm  view on Meta::CPAN

   $w->{'Text'}[-1]->Call("\n");
  }
 else
  {
   $w->nl(1);
  }
 return $w;
}

sub hr
{
 my ($h,$f,$elem) = @_;
 return 0 unless $f;
 my $w = $h->{widget};
 my $r = $w->Frame(-height => 2,
                   -width => $w->cget('-width')*140,
                   -borderwidth => 1, -relief => 'sunken',
                  );
 $h->nl(1);
 $w->window('create','insert','-window' => $r, -pady => 0, -padx => 0);
 $h->{NL} = 0;
 $h->{'BODY'} = 1;
 $h->nl(1);
 return $f;
}

sub DeEscape
{
 my ($var,$text) = @_;
 $$var .= HTML::Entities::decode($text);
}

sub td_grid
{
 my ($h,$f,$elem) = @_;
 my $table = $elem->enclosing(1,'table');
 if ($f)
  {
   $elem->{Text} = "";
   $h->TextHandler([\&DeEscape,\$elem->{Text}]);
  }
 else
  {
   my $tw = $table->{widget};
   my @elem = ();
   my $al = $elem->{ALIGN};
   if (defined $al)
    {
     push(@elem,-justify => 'right',-anchor => 'e') if ($al =~ /RIGHT/i);
    }
   my $widget = $elem->{'widget'};
   unless (defined $widget)
    {
     $widget = $tw->Label(-relief => 'ridge',@elem, -text => $elem->{Text},
                                config($elem,
                                -background => 'bgcolor'));
    }
   $widget->grid(-in => $tw, -row => $table->{Row}, -column => $table->{Col},
                 config($elem,
                        -rowspan => 'rowspan',
                        -columnspan => 'colspan'), -sticky => 'nsew');
   pop(@{$h->{'Text'}});
   $table->{Col}++;
  }
 return $f;
}



sub broken_td
{
 my ($h,$f,$elem) = @_;
 my $row   = $elem->enclosing(1,'tr');
 my $table = $row->enclosing(1,'table');
 my $tw = $table->{widget};
 if ($f)
  {
   my $w = $h->{'widget'};
   $elem->{'widget'} = $w;
#  my $class = ref($w);
#  my @args = ();
#  foreach my $opt ($w->configure)
#   {
#    if (@$opt != 2)
#     {
#      my $val = $opt->[-1];
#      my $def = $opt->[-2];
#      push(@args,$opt->[0],$val) if defined($val) && (!defined($def) || $val ne $def);
#     }
#   }
#  print join(' ','New:',@args),"\n";
#  print format_attr($elem),"\n";
   my @elem = ();
   my $al = $elem->attr('align');
   if (defined $al)
    {
     push(@elem,-justify => 'right',-anchor => 'e') if ($al =~ /RIGHT/i);
    }
   my $widget = Tk::HTML->new($tw, -relief => 'ridge',@elem,
                              config($elem,
                              -background => 'bgcolor'),
                              -width => 0, -height => 0);
   $widget->grid(-in => $tw, -row => $table->{Row}, -column => $table->{Col},
                 config($elem,
                        -rowspan => 'rowspan',
                        -columnspan => 'colspan'), -sticky => 'nsew');
   $h->{'widget'} = $widget;
  }
 else
  {
   my $widget = $h->{'widget'};
   # $widget->GeometryRequest(0,0);
   $h->{'widget'} = $elem->{widget};
   $table->{Col}++;
  }
 return $f;
}

sub format_attr
{
 my $elm = shift;
 my $str = '<'.$elm->tag.' ';
 my $sep = '';
 my @list = %$elm;
 while (@list)
  {
   my ($key,$val) = splice(@list,0,2);
   next if $key =~ /^_/;
   $str .= "$sep$key=\"$val\"";
   $sep = ', ';
  }
 return $str . '>';
}

sub config
{
 my $elem = shift;
 my @args;
 while (@_)
  {
   my ($opt,$attr) = splice(@_,0,2);
   my $val = $elem->attr($attr);
   push(@args,$opt => $val) if defined $val;
  }
 return @args;
}

sub table
{
 my ($h,$f,$elem) = @_;
 return $f;
}

sub td
{
 my ($h,$f,$elem) = @_;
 return $f;
}

sub tr
{
 my ($h,$f,$elem) = @_;
 return $h->br($f,$elem)
}

sub table_grid