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

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->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 => 'U', -relief => 'flat', -background => 'green',
                -font => $self->Font(-family => 'times', -size => '8'),
                -command => [sub {
                        my ($self) = @_;
			my $color = $self->chooseColor(
			    -initialcolor => 'black', -parent => $self,
			    -title => 'Choose Background 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 not defined for this range - add it from the composite tag name and then add the resulting
                        # tag, creating it if necessary
                        return unless $cur_tag ne "";
                        $self->{text}->tagRemove($cur_tag, 'insert');
                        $cur_tag =~ s/$tag//i;
			print "creating tag\n";
                        $self->create_tag($cur_tag);
			print "tag created\n";
                        $self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']);
                        $self->tagAdd($cur_tag, 'insert');
                        $self->{$button}->configure(-relief => 'flat');
			print "done\n";
                }
                else
                {
                        # tag not enabled for this range - remove it
                        $self->{text}->tagRemove($cur_tag, 'insert');
                        $cur_tag .= $tag;
                        $self->create_tag($cur_tag);
                        $self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']);
                        $self->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);
		$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';
        }

	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 @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");
        }
        $res =~ s/\%*ignore\%*//g;
        return $res;
}
sub end_tag
{
        my ($tag) = @_;
        $tag =~ s/^</<\//;
        return $tag;
}

1;