package Tk::BrowseEdit;

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

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 => 'times', -weight => 'bold', -size => '8'),
		-command => [sub {
			my ($self) = @_;
			$self->toggleTag('<b>');
		}, $self]
		)->pack(-pady => 0, -side => 'left', -fill => 'both');
	$self->{text}->tagConfigure('<b>', -font => $self->Font(-family => 'times', -weight => 'bold'));
	$self->{text}->bind('<Control-B>', [sub { shift->{'<b>'}->invoke; }, $self]);

	$self->{'<i>'} = $self->{panel}->Button(-text => 'I', -relief => 'flat',
		-font => $self->Font(-family => 'times', -slant => 'italic', -size => '8'),
		-command => [sub {
			my ($self) = @_;
			$self->toggleTag('<i>');
		}, $self]
		)->pack(-pady => 0, -side => 'left', -fill => 'both');
	$self->{text}->tagConfigure('<i>', -font => $self->Font(-family => 'times', -slant => 'italic'));
	$self->bind('<Control-I>', [sub { shift->{'<b>'}->invoke; }, $self]);

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

	$self->ConfigSpecs(
		'DEFAULT' => [$self->{text}],
		-background => [$self]
	);

	$self->Delegates(
		'DEFAULT' => $self->{text},
		'to_html' => $self,
	);

	$self->after(200, [$self, "init"]);
}

sub toggleTag
{
	my ($self, $tag) = @_;

	if(!defined($self->{text}->tagRanges('sel')))
	{
		if(!$self->{tags}->{$tag})
		{
			$self->{text}->insert('insert', '%ignore%', [$tag, 'elide']);
			$self->{text}->tagAdd($tag, 'insert');
			$self->{tags}->{$tag} = 1;
			$self->{$tag}->configure(-relief => 'groove');
		}
		else
		{
			$self->{text}->insert('insert', '%ignore%', ['elide']);
			$self->{text}->tagRemove($tag, 'insert');
			$self->{tags}->{$tag} = 0;
			$self->{$tag}->configure(-relief => 'flat');
		}
	}
	else
	{
		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)
				{
					$self->{text}->tagRemove($tag, $self->{text}->tagRanges('sel'));
				$self->{$tag}->configure(-relief => 'raised');
					return;
				}
			}
		}

		$self->{text}->tagAdd($tag, $self->{text}->tagRanges('sel'));
		$self->{$tag}->configure(-relief => 'sunken');
	}
}

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

	$start ||= '0.0';
	$end ||= 'end';

	my @tags = $self->{text}->tagNames;

	my $res;

	my $pos = '1.0';
	my $chars;
	my %curtags;
	my %chartags;
	my (@addtags, @deltags);

	while($self->{text}->index($pos) != $self->{text}->index('end'))
	{
		%chartags = ();
		$chartags{$_} = 1 for $self->{text}->tagNames($pos);
		delete $chartags{'elide'};
		delete $chartags{'sel'};


		for (keys %chartags)
		{
			push @addtags, $_ unless $curtags{$_}
		}
		
		for (keys %curtags)
		{
			push @deltags, $_ if !$chartags{$_};
		}
		
		%curtags = ();
		$curtags{$_} = 1 for keys %chartags;

		$res .= $_ for @addtags;
		$res .= end_tag($_) for @deltags;

		@deltags = @addtags = ();

		$res .= $self->{text}->get($pos);
		$pos = $self->{text}->index('0.0 + ' . ++$chars . " chars");
	}

	return $res;
}

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

sub init
{
	my ($self) = @_;

	$self->{text}->configure(-background => 'white');
}

1;