milkbone/plugins/Tk-GUI/Tk/BrowseEdit.pm

package Tk::BrowseEdit;

use Tk;
use Tk::Font;
use Tk::ColorChoice;
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->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) = @_;
			print "hit b\n";
                        $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 => 'times', -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 => 'times', -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 => 'A', -relief => 'flat', -background => 'blue',
                -font => $self->Font(-family => 'times', -size => '8'),
                -command => [sub {
                        my ($self) = @_;
			my $color = $self->pick_color;
		      
                        $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
	        print "starting\n";
                my $cur_tag = ($self->{text}->tagNames('insert'))[0] || "";
		print "tag names gotten\n";
                if ($cur_tag =~ /$tag/i)
                {
                        # tag is defined for this region - remove it

                        return if $cur_tag eq "";
                        $self->{text}->tagRemove($cur_tag, 'insert');
			print "tagremove $cur_tag\n";
                        $cur_tag =~ s/$tag//i;
                        $self->create_tag($cur_tag);
                        $self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']);
                        $self->{$button}->configure(-relief => 'flat');
			print "done\n";
                }
                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);
                        $self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']);
                        $self->tagAdd($cur_tag, 'insert');
			print "tagadd $cur_tag\n";
                        $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'));
		print "Added $tag\n";
                $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='(.*?)'>/)
        {
                $fontparams{-slant} = 'italic';
        }

	my $font = $self->Font(%fontparams);
        $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 = '1.0';
	my $chars = 0;
	my ($curtag, $prevtag) = ("", "");
	my %all_tags;
        while($self->{text}->index($pos) != $self->{text}->index('end'))
        {
	    print Dumper([$self->{text}->tagNames($pos)]) . "\n";
	    $all_tags{$_} = $_ for $self->{text}->tagNames($pos);
	    delete @all_tags{'elide', 'sel', ''};

	    $curtag = (keys %all_tags)[0];

	    print Dumper(\%all_tags);
	    print $self->{text}->get($pos) . "\n";

	    if($curtag =~ /$prevtag/)
	    {
		($temp = $curtag) =~ s/$prevtag//;
		$res .= $temp;
	    }
	    else
	    {
		($temp = $prevtag) =~ s/$curtag//;
		$res .= end_tag($temp);
	    }

	    $prevtag = $curtag;
	    
            $res .= $self->{text}->get($pos);
            $pos = $self->{text}->index('0.0 + ' . ++$chars . " chars");
        }
        $res =~ s/\%*ignore\%*//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');

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

    return unless $res eq "OK";
    
}

1;