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;