#
#
#  WARNING - THIS IS CHEWBACCA CODE - IT DOES NOT MAKE SENSE.  DO NOT MAKE ANY 
#  CHANGES TO THIS FILE, FOR IT FUNCTIONS IF AND ONLY IF THE CODE IS EXACTLY 
#  AS IT IS AND EVEN THEN ONLY WORKS PROPERLY DURING A FULL MOON ON THE THIRD 
#  THURSRDAY OF ODD-NUMBERED MONTHS IN THE SPRING WHEN THERE'S SNOW ON THE 
#  GROUND.
#
#  YOU HAVE BEEN WARNED.  DO NOT BLAME ME IF THIS CODE DOES NOT WORK, EATS 
#  YOUR CHILDREN, OR FAXES HUNDREDS OF COPIES OF ITSELF TO GUAM.
#
#  IT DOES NOT MAKE SENSE!!!! (Look at the monkey, look at the silly monkey...)
#
#  - batkins (8-21-03)
#

package Tk::BrowseEdit;

use Tk;
use Tk::Font;
use base 'Tk::Frame';
use Data::Dumper;

use strict;
use warnings;

Construct Tk::Widget 'BrowseEdit';

sub ClassInit
{
        my ($class, $mw) = @_;
        $class->SUPER::ClassInit($mw);
}

sub Populate
{
        my ($self, $args) = @_;
        $self->SUPER::Populate($args);
        $self->{panel} = $self->Frame(-borderwidth => 0)->pack(-fill => 'both');
        $self->{text} = $self->Text(-background => 'white')->pack(-expand => 1, -fill => 'both');
        $self->{'<b>'} = $self->{panel}->Button(-text => 'B', -relief => 'flat',
                -font => $self->Font(-family => '{adobe arial}', -weight => 'bold', -size => '8'),
                -command => [sub {
                        my ($self) = @_;
                        $self->toggleTag('<b>');
                }, $self]
                )->pack(-pady => 0, -side => 'left', -fill => 'both');
        $self->{text}->bind('<Control-B>', [sub { shift->{'<b>'}->invoke; },
$self]);
        $self->{'<i>'} = $self->{panel}->Button(-text => 'I', -relief => 'flat',
                -font => $self->Font(-family => '{adobe arial}', -slant => 'italic', -size => '8'),
                -command => [sub {
                        my ($self) = @_;
                        $self->toggleTag('<i>');
                }, $self]
                )->pack(-pady => 0, -side => 'left', -fill => 'both');
        $self->bind('<Control-I>', [sub { shift->{'<b>'}->invoke; }, $self]);

        $self->{'<u>'} = $self->{panel}->Button(-text => 'U', -relief => 'flat',
                -font => $self->Font(-family => '{adobe arial}', -underline => 1, -size => '8'),
                -command => [sub {
                        my ($self) = @_;
                        $self->toggleTag('<u>');
                }, $self]
                )->pack(-pady => 0, -side => 'left', -fill => 'both');
        $self->bind('<Control-U>', [sub { shift->{'<b>'}->invoke; }, $self]);

#        $self->{'<back>'} = $self->{panel}->Button(-text => 'back', -relief => 'flat', -background => 'blue',
#				-activebackground => 'blue',
#                -font => $self->Font(-family => 'times', -size => '8'),
#                -command => [sub {
#                        my ($self) = @_;
#						my $color = $self->pick_color;
#						return if $color eq "NOTACOLOR";
#		      
#                        $self->toggleTag("<font back=\"$color\">", '<back>');
#                }, $self]
#                )->pack(-pady => 0, -side => 'left', -fill => 'both');
        $self->bind('<Control-U>', [sub { shift->{'<b>'}->invoke; }, $self]);

        $self->{text}->tagConfigure('elide', -elide => 1);
        $self->ConfigSpecs(
                'DEFAULT' => [$self->{text}],
                -background => [$self]
        );
        $self->Delegates(
                'DEFAULT' => $self->{text},
                'to_html' => $self,
        );
}

sub insert
{
    shift->{text}->insert(@_);
}

sub toggleTag
{
        my ($self, $tag, $button) = @_;
	$button = defined($button) ? $button : $tag;
        if(!defined($self->{text}->tagRanges('sel')))
        {
                # no selection - modify current position
          	my @tags = $self->{text}->tagNames('insert');
                my $cur_tag = (scalar(@tags) > 0 ? $tags[0] : "");
                if ($cur_tag =~ /$tag/i)
                {
                        # tag is defined for this region - remove it
                        return if $cur_tag eq "";
                        $self->{text}->tagRemove($cur_tag, 'insert');
                        $cur_tag =~ s/$tag//i;
                        $self->create_tag($cur_tag);
						$self->{text}->tagAdd($cur_tag, 'insert');
                        $self->insert('insert', chr(255), [$cur_tag, 'elide']) if $cur_tag ne "";                 
						$self->insert('insert', chr(255), ['elide']) if $cur_tag eq "";
                        $self->{$button}->configure(-relief => 'flat');
                }
                else
                {
                        # tag not enabled for this range - add it
                        $self->{text}->tagRemove($cur_tag, 'insert');
                        $cur_tag .= $tag;
			return unless $cur_tag && $cur_tag ne "";
                        $self->create_tag($cur_tag) unless $cur_tag eq "";
                        $self->insert('insert', chr(255), [$cur_tag, 'elide']) if $cur_tag ne "";
                        $self->insert('insert', chr(255), ['elide']) if $cur_tag eq "";
                        $self->{text}->tagAdd($cur_tag, 'insert');
                        $self->{$button}->configure(-relief => 'sunken');
                }
        }
        else
        {
			my $removed;
			my $new_tag;
			for my $wholetag ($self->{text}->tagNames())
			{
					next unless $wholetag =~ /$tag/;
					my ($selstart, $selend) = $self->{text}->tagRanges('sel');
					my @tags = $self->{text}->tagRanges($tag);
					my (@starts, @ends);
					for(my $i = 0; $i < @tags; $i += 2)
					{
							push @starts, $tags[$i];
							push @ends, $tags[$i + 1];
					}
					for my $start (@starts)
					{
							for my $end (@ends)
							{
									if($selstart >= $start and $selend <= $end)
									{
										$new_tag .= $tag;
										$self->{$tag}->configure(-relief => 'flat');
										$removed = 1;
										return;
									}
							}
					}
			}
		   
			unless($removed)
			{
				self->create_tag($new_tag);
				return unless $tag;
				$self->{text}->tagAdd($tag, $self->{text}->tagRanges('sel'));
				$self->{$tag}->configure(-relief => 'sunken');
			}	
        }
}

sub create_tag
{
        my ($self, $tag) = @_;
        return if $self->{created_tags}->{$tag};
        my (%tagparams, %fontparams);
        if($tag =~ /<u>/)
        {
                $fontparams{-underline} = 1;
        }
        if($tag =~ /<b>/)
        {
                $fontparams{-weight} = 'bold';
        }
        if($tag =~ /<i>/)
        {
                $fontparams{-slant} = 'italic';
        }
        if($tag =~ /<font back=('|")(.*?)('|")>/)
        {
                $tagparams{-background} = $2;
        }

        my $font = $self->Font(-family => 'times',%fontparams);
        print %fontparams;
        # XXX: SEGMENTATION FAULT HERE!!
        $self->tagConfigure($tag, %tagparams, -font => $font);
        $self->{created_tags}->{$tag} = 1;
}

sub to_html
{
        my ($self, $start, $end) = @_;
        $start ||= '0.0';
        $end ||= 'end';

        my ($res, $temp);
        my $pos = '0.0';
	my $chars = 0;
	my ($curtag, $prevtag) = ("", "");
	my %all_tags;
        
	while($self->{text}->index($pos) != $self->{text}->index('end'))
        {
          %all_tags = ();
          $all_tags{$_} = $_ for $self->{text}->tagNames($pos);
          delete $all_tags{'sel'};
          delete $all_tags{'elide'};
          delete $all_tags{''};
          
          if(scalar(keys %all_tags) == 0 && $prevtag eq "")
            {
              $res .= $self->{text}->get($pos);
              $pos = $self->{text}->index('0.0 + ' . ++$chars . " chars");
              $prevtag = "";
              next;
            }
          
          $curtag = (keys %all_tags)[0] || "";
          

          if($prevtag =~ /$curtag/)
            {
              # tag added
              ($temp = $prevtag) =~ s/$curtag//;
              $res .= end_tag($temp);
            }
          elsif($curtag =~ /$prevtag/)
            {
              # tag removed
              ($temp = $curtag) =~ s/$prevtag//;
              $res .= $temp;
            }
          
          $prevtag = $curtag;
	    
          $res .= $self->{text}->get($pos);
          $pos = $self->{text}->index('0.0 + ' . ++$chars . " chars");
        }
        
        my $chr = chr(255);
        $res =~ s/$chr//g;
        return $res;
}

sub end_tag
{
        my ($tag) = @_;
        $tag =~ s/^</<\//g;
        return $tag;
}

sub pick_color
{
    my ($self) = @_;
    my $dlg = $self->Parent->DialogBox(-title => 'Choose Color', -buttons => 
			       ['OK', 'Cancel'], -default_button => 'OK');

    my $wid = $dlg->ColorChoice->pack;
    my $res = $dlg->Show();

    return "NOTACOLOR" unless $res eq "OK";
	return $wid->{color};
}

1;