package Tk::HTML::Handler;
require HTML::Parse;
require Tk::HTML::Form;
require Tk::Table;

use Carp;

delete $HTML::Element::OVERLOAD{'""'};

sub HTML::Element::enclosing
{
 my $self = shift;
 my $must = shift;
 my $p = $self;
 while (defined $p) 
  {
   my $ptag = $p->{'_tag'};
   for (@_) 
    {
     return $p if $ptag eq $_;
    }
   $p = $p->{'_parent'};
  }
 Carp::croak $self->tag . " is not in ".join(' ',@_) if ($must);
 return undef;
}

my %FontTag = ('CITE' => 'I', 'STRONG' => 'B', 'EM' => 'B', 
                      'TT' => 'KBD', 'SAMP' => 'CODE');

my $tag; 
foreach $tag (qw(b i samp code kbd strong em var cite dfn tt))
 {
  *{"$tag"} = \&FontTag;
 }

foreach $tag (qw(address html blink))
 {
  *{"$tag"} = \&DoesNothing;
 }

foreach $tag (qw(dl ul menu dir ol))
 {
  *{"$tag"} = \&List;
 }

foreach $tag (1..6)
 {
  *{"h$tag"} = \&Heading;
 }

foreach $tag (qw(tagAdd insert))
 {
  *{"$tag"} = sub { shift->{widget}->$tag(@_) };
 }


*th   = \&td;
*link = \&a;

sub AUTOLOAD
{
 my $what = $AUTOLOAD;
 # print "AUTOLOAD:$what\n";
 my($package,$method) = ($what =~ /^(.*)::([^:]*)$/);
 warn "Don't know how to $method";
 print STDERR "Don't know how to $method\n";
 *{"$what"} = sub { return 1 };
 goto &$what;
}

use strict;

sub Widget { shift->{widget} }

sub DESTROY
{

}

sub new
{
 my ($class,%args) = @_;
 my $w = $args{widget};
 $w->delete('0.0','end');
 $args{NL}   = 2;
 $args{BODY} = 1;
 $args{Count} = 0;
 $args{'List'} = [];
 $args{'FORM'}   = []; # all forms defined for this document
 $args{'Text'}   = []; # Current place to send Text
 $args{'Option'} = []; # Current place to send Option
 return bless \%args,$class;
}

sub CurrentForm
{
 my ($w,$f) = @_;
 if (@_ > 1)
  {
   $w->{'CurrentForm'} = $f;
  }
 return $w->{'CurrentForm'};
}

sub GenTag
{
 my $w = shift;
 my $prefix = shift;
 my $tag = $prefix . ++$w->{Count};
 $w->{'GenTag'} = [] unless (exists $w->{'GenTag'});
 push(@{$w->{'GenTag'}},$tag);
 $w->{widget}->tagConfigure($tag,@_) if (@_);
 return $tag;
}

sub TextHandler
{
 my $w = shift;
 if (@_)
  {
   push(@{$w->{'Text'}},Tk::Callback->new(@_));
  }
 else
  {
   return (@{$w->{'Text'}}) ? $w->{'Text'}[-1] : undef;
  }
}

sub nl
{
 my ($w,$n) = @_;
 while ($w->{'NL'} < $n)
  {
   $w->insert('insert',"\n");
   $w->{'NL'}++;
  }
}

sub ElemTag
{
 my ($w,$elem) = @_;
 my $tag = uc $elem->tag;
 $w->tagAdd($tag,$elem->{'_Start_'},$elem->{'_End_'});
}

sub FontTag
{
 my ($w,$f,$elem) = @_;
 if (!$f)
  {
   my $tag = uc $elem->tag;
   $tag = $FontTag{$tag} if (exists $FontTag{$tag});
   $w->tagAdd($tag,$elem->{'_Start_'},$elem->{'_End_'});
  }
 return $f;
}

sub body
{
 my ($w,$f,$elem) = @_;
 $w->{'BODY'} = 1;
 return $w;
}

sub script
{
 my ($w,$f,$elem) = @_;
 $w->{'BODY'} = 0;
 return $w;
}

sub bgsound
{
 my ($w,$f,$elem) = @_;
 return 0;
}

sub head
{
 my ($w,$f,$elem) = @_;
 $w->{'BODY'} = 0;
 return $w;
}

sub a
{
 my ($h,$f,$elem) = @_;
 if (!$f)
  {
   my $w = $h->{widget};
   my $href = $elem->attr('href');
   my $name = $elem->attr('name');
   if ($href)
    {
     my $tag  = $h->GenTag('HREF',-underline => 1);
     $w->tagAdd($tag,$elem->{'_Start_'},$elem->{'_End_'});
     $w->tagBind($tag,'<Button-1>',[$w,'HREF',$href,'GET']);
     $w->tagBind($tag,'<Enter>',[$w,'Callback','-showlink',$href]);
    }
   if ($name)
    {
     $w->tagAdd($name,$elem->{'_Start_'},$elem->{'_End_'});
     push(@{$h->{'GenTag'}},$name);
    }
  }
 return $f;
}

sub li
{
 my ($w,$f,$elem) = @_;
 if ($f)
  {
   my $list = $elem->enclosing(1,qw(ul ol dir menu));
   if ($list->tag eq 'ol')
    {
     my $n = ++$list->{Num};
     $w->insert('insert',"\n $n. ");
    }
   else
    {
     # $w->insert('insert',"\n \xA8 ",['symbol']);
     $w->insert('insert',"\n \xB7 ",['symbol']);
    }
  }
 return $w;
}

sub dt
{
 my ($w,$f,$elem) = @_;
 $w->nl(1+$f);
 return $w;
}

sub dd
{
 my ($w,$f,$elem) = @_;
 $w->nl(1);
 return $w;
}


sub tr
{
 my ($w,$f,$elem) = @_;
 my $table = $elem->enclosing(1,'table');
 if ($f)
  {
   $elem->{Col} = 0;
  }
 else
  {
   $table->{widget}->configure(-columns => $elem->{Col});
   $table->{Row}++;
  }
 return $w;
} 

sub p
{
 my ($w,$f,$elem) = @_;
 $w->{'BODY'} = 1;
 $w->nl(2);
 return $w;
}

sub br
{
 my ($w,$f,$elem) = @_;
 $w->{'BODY'} = 1;
 if (@{$w->{'Text'}})
  {
   $w->{'Text'}[-1]->Call("\n");
  }
 else
  {
   $w->nl(1);
  }
 return $w;
}

sub hr
{
 my ($h,$f,$elem) = @_;
 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
{
 my ($w,$f,$elem) = @_;
 my $row   = $elem->enclosing(1,'tr');
 my $table = $row->enclosing(1,'table');
 if ($f)
  {
   $elem->{Text} = "";
   $w->TextHandler([\&DeEscape,\$elem->{Text}]);
  }
 else
  {
   my $w = $table->{widget};
   my @elem = ();
   my $al = $elem->{ALIGN};
   if (defined $al)
    {
     push(@elem,-justify => 'right',-anchor => 'e') if ($al =~ /RIGHT/i);
    }
   $w->Create($table->{Row},$row->{Col},'Message',-aspect => 300, 
           -relief => 'ridge', -text => $elem->{Text},@elem);
   pop(@{$w->{'Text'}});
   $row->{Col}++;
  }
 return $w;
} 

sub table
{
 my ($h,$f,$elem) = @_;
 if ($f)
  {
   my $w = $h->Widget;
   $elem->{widget} = $w->Scrolled('Table');
   $elem->{Row}    = 0;
   $w->window('create','insert',-window => $elem->{widget});
   print "Table:",join(',',%$elem),"\n";
  }
 else
  {
#   $elem->{widget}->configure(-rows => $elem->{Row});
  }
 return $h;
}

sub form
{
 my ($w,$f,$form) = @_;
 $w->{'BODY'} = 1;
 if ($f)
  {
   $form->{OldForm} = $w->CurrentForm;
   bless $form,'Tk::HTML::Form';
   push(@{$w->{'FORM'}},$form);
   $form->{'Values'}  = [];
   $form->{'Owner'} = $w;
   $w->CurrentForm($form);
  }
 else
  {
   my $what;
   my @val = ();
   foreach $what (@{$form->{'Values'}})
    {
     my $val = $what->[1];
     if (ref($val))
      {
       $val = $val->Call();
      }
     push(@val,$val);
    }
   $form->{'Reset'} = \@val;
   $w->CurrentForm(delete $form->{OldForm});
  }
 $w->nl(1);
 return $w;
}

sub input 
{
 my($w,$f,$elem) = @_;
 my $form = $w->CurrentForm;
 my $type = $elem->attr('type');
 $elem->attr(type => ($type = 'TEXT')) unless (defined $type);
 $type = "\U$type";
 $form->$type($elem);
 return $w;
}

sub option 
{
 my ($w,$f,$elem) = @_;
 if ($f)
  {
   push(@{$w->{'option'}},$elem);
  }
 else
  {
   pop(@{$w->{'option'}});
  }
 return $f;
}

sub OptionText
{
 my ($h,$mb,$text) = @_;
 my $elem = $h->{'option'}[-1];
 if (defined $elem)
  {
   my $val = $elem->attr('value');
   $text =~ s/^\s+//;
   $text =~ s/\s+$//;
   $elem->attr('value' => $text) unless ($val);
   if ($elem->attr('value') ne $text)                         
    {                                                     
     $mb->{'FORM_MAP'} = {} unless (exists $mb->{'FORM_MAP'});
     $mb->{'FORM_MAP'}{$text} = $elem->attr('value');
    }                                                     
   $mb->options([$text]);                                 
   $mb->setOption($text) if ($elem->attr('selected'));
  }
 else
  {
   confess "$text outside option";
  }
}

sub MultipleText
{
 my ($h,$lb,$text) = @_;
 $text =~ s/^\s+//;
 $text =~ s/\s+$//;
 my $elem = $h->{'option'}[-1];
 if (defined $elem)
  {
   my $index = $lb->index('end');
   $elem = {} unless (defined $elem);
   $elem->{'VALUE'} = $text unless (exists $elem->{'VALUE'});
   if ($elem->{'VALUE'} ne $text)
    {                        
     $lb->{'FORM_MAP'} = [] unless (exists $lb->{'FORM_MAP'});
     $lb->{'FORM_MAP'}[$index] = $elem->{'VALUE'};
    }                        
   $lb->insert($index,$text);
   $lb->selection('set',$index) if (defined $elem->{'SELECTED'});
  }
 else
  {
   confess "$text outside option";
  }
}

sub select 
{
 my($h,$f,$elem) = @_;
 if ($f) 
  {
   $h->{NL} = 0;
   my $w = $h->Widget;
   my $form = $h->CurrentForm;
   $h->{'option'} = [];
   if ($elem->attr('multiple') || (defined $elem->{'size'} && $elem->{'size'} > 1)) 
    {
     my $size = $elem->attr('size');
     $size = 15 unless ($size);
     my $e = $w->Scrolled('Listbox',-height => $size,-scrollbars => 'e');
     $e->configure(-selectmode => 'multiple') if $elem->attr('multiple');
     $w->window('create','insert',-window => $e);
     if (defined $form)
      {
       my $var = $form->Variable($elem);
       $$var   = Tk::Callback->new([\&Tk::HTML::Form::MultipleValue,$e]);
      }
     $h->TextHandler([\&MultipleText,$h,$e]);
    } 
   else 
    {
     my $buttonvar = "__not__";
     my $mb = $w->Optionmenu(-textvariable => \$buttonvar,-relief => 'raised');
     $w->window('create','insert',-window => $mb);
     if (defined $form)
      {
       my $var = $form->Variable($elem);
       $$var   = Tk::Callback->new([\&Tk::HTML::Form::OptionValue,$mb,\$buttonvar]);
      }
     $h->TextHandler([\&OptionText,$h,$mb]);
    }
  } 
 else 
  {
   pop(@{$h->{'Text'}});
   delete $h->{'option'};
  }
 return $f;
}

sub textarea 
{
  my($h,$f,$elem) = @_;
  if ($f) 
   {
    my $rows = $elem->attr('rows') || 20;
    my $cols = $elem->attr('cols') || 12;
    my $form = $h->CurrentForm;
    my $w = $h->Widget;
    $elem->{'NAME'} = '__inconnu__' if ! defined $elem->{'NAME'};
    my $t = $w->Scrolled('Text',-wrap => 'none',  -relief => 'sunken', -scrollbars => 'se',
                          -width => $cols, -height => $rows);
    $w->{'textarea'} = $t;
    if (defined $form)
     {
      my $var = $form->Variable($elem);
      $$var   = Tk::Callback->new([$t,'Contents']);
     }
    $w->window('create','insert',-window => $t);
    $h->{NL} = 0;
    $h->TextHandler([$t,'insert','end']);
   } 
  else 
   {
    pop(@{$h->{'Text'}});
   }
 return $f;
}
  
sub base 
{
 print STDERR "base(",join(',',@_),")\n";
 my($h,$f,$elem) = @_;
 $h->{'BODY'} = 0;
 print STDERR "base elem=$elem\n";
 my $w = $h->Widget;
 $w->base($elem->attr('href'));
 return 1
}

sub isindex 
{
 my($h,$f,$elem) = @_;
 $h->{'BODY'} = 0;
 if ($f)
  {
   my $w = $h->{widget};
   $h->hr($f,$elem);
   $w->insert('end','This is a searchable index, enter keyword(s) : ');
   my $e = $w->Entry;
   $e->bind('<Return>',[$w,'call_ISINDEX',$e]);
   $w->window('create','end',-window => $e);
   $h->{NL} = 0;    
   $h->hr($f,$elem);
  }
 return $f;
}

sub img
{
 my ($h,$f,$elem) = @_;
 my $w = $h->{widget};
 my $alt = $elem->attr('alt') || ">>Missing IMG<<";
 my $l = $w->Label(-text => $alt);
 my $al = $elem->attr('align');
 my @al = (-align => 'baseline');
 if (defined $al)
  {
   my $al = "\U$al";
   if ($al eq "MIDDLE")
    {
     @al = (-align => 'center') 
    }
   elsif ($al eq "BOTTOM")
    {
     @al = (-align => 'baseline') 
    }
   elsif ($al eq "TOP")
    {
     @al = (-align => 'top') 
    }
   else
    {
     print "Align '$al'?\n";
    }
  }
 $w->window('create','insert','-window' => $l, @al);
 $h->{NL} = 0;                
 my $src = $elem->attr('src');
 $w->FindImage($src,$l) if ($src);
 my $a = $elem->enclosing(0,'a');
 if ($a || $elem->attr('image'))
  {
   $l->configure('-cursor' => "top_left_arrow", -borderwidth => 3, -relief => 'raised');
   if ($elem->attr('ismap') && $a)
    {
     $l->bind('<1>',[$w,'IMG_CLICK',$l,'ISMAP',$a->attr('href')]);
    } 
   elsif ($elem->attr('image'))
    {
     $l->bind('<1>',[$w,'IMG_CLICK',$l,'IMAGE',$f,$elem->attr('name')]);
    } 
   elsif ($a)
    {
     $l->bind('<1>',[$w,'IMG_CLICK',$l,'AREF',$a->attr('href')]);
    }
  }
 return $f;
}

sub title
{
 my ($w,$f,$elem) = @_;
 if ($f)
  {
   $w->{TITLE} = "";
   $w->TextHandler(sub { $w->{TITLE} .= shift });
   $w->{'BODY'} = 0;
  }
 else
  {
   $w->{widget}->toplevel->title($w->{TITLE});
   pop(@{$w->{'Text'}});
  }
 return $w;
}

sub Heading
{
 my ($w,$f,$elem) = @_;
 $w->nl(2);
 if (!$f)
  {
   my $tag = uc $elem->tag;
   my $align = $elem->attr('align');
   $w->{widget}->tagConfigure($tag,-justify => lc($align)) if ($align);
   $w->ElemTag($elem);
  }
 return $w;
}

sub blockquote
{
 my ($w,$f,$elem) = @_;
 if ($f)
  {
   $w->nl(1);
  }
 else
  {
   $w->ElemTag($elem);
   $w->nl(1);
  }
 return $w;
}

sub center
{
 my ($w,$f,$elem) = @_;
 if ($f)
  {
   $w->nl(1);
  }
 else
  {
   $w->ElemTag($elem);
   $w->nl(1);
  }
 return $w;
}

sub DoesNothing
{
 my ($w,$f,$elem) = @_;
 return $f;
}

sub pre
{
 my ($h,$f,$elem) = @_;
 $h->{'PRE'} = $f;
 if (!$f)
  {
   $h->tagAdd('CODE',$elem->{'_Start_'},$elem->{'_End_'});
  }
 return $f;
}

sub List
{
 my ($w,$f,$elem) = @_;
 if ($f)
  {
   $elem->{Num} = 0;
   push(@{$w->{'List'}},['LI' . $elem->tag,0,$elem->{'_Start_'}]);
   my $depth = @{$w->{'List'}};
   if ($depth > 1) 
    {
     my $len = ($depth - 1) * 20;
     my $tag = $w->GenTag($elem->tag . "temp",
                          -lmargin1 => $len, 
                          -lmargin2 => $len,
                          -rmargin => $len);
     $w->tagAdd($tag,${${$w->{'List'}}[$depth-2]}[2],${${$w->{'List'}}[$depth-1]}[2]);
    }
  }
 else
  {
   my $depth = @{$w->{'List'}};
   if ($depth > 1) 
    {
     ${${$w->{'List'}}[$depth - 2]}[2] = $elem->{'_End_'};
     my $len = $depth * 20;
     my $tag = $w->GenTag($elem->tag,
                          -lmargin1 => $len, 
                          -lmargin2 => $len,
                          -rmargin => $len);
     $w->tagAdd($tag,${${$w->{'List'}}[$depth - 1]}[2],$elem->{'_End_'});
    }
   pop(@{$w->{'List'}});
  }
 return $f;
}

sub traverse
{
 my ($h,$elem,$start,$depth) = @_;
 # print ' 'x$depth,$start," ",(ref $elem) ? $elem->tag : $elem,"\n";
 if (ref $elem)
  {
   my $tag = $elem->tag;
   my $posn = $h->{widget}->index('insert');
   if ($start)
    {
     $elem->{'_Start_'} = $posn;
    }
   else
    {
     $elem->{'_End_'} = $posn;
    }
   return $h->$tag($start,$elem);
  }
 else
  {
   my $text = $elem;
   if (defined(substr($text,0,1)))
    {
     if (@{$h->{'Text'}})
      {
       $h->{'Text'}[-1]->Call($text);
      }
     else
      {
       return unless ($h->{'BODY'});
       unless ($h->{'PRE'})
        {
         $text =~ s/\n/ /mg;
         $text =~ s/^\s+//g;
         $text =~ s/\s\s+/ /g;
         $text =~ s/\s+$//g;
        }
       $text = HTML::Entities::decode($text);
       if (length(substr($text,0,1)))
        {
         my $w = $h->{'widget'};
         $w->insert('insert',' ',qw(text)) unless ($h->{NL});
         $w->insert('insert',$text,qw(text));
         $h->{NL} = 0;                
         $h->{NL} = 1 if ($text =~ /\n$/);
        }
      }
    }
   return 1;
  }
}


