|
|
@ -1,15 +1,20 @@ |
|
|
|
package Tk::BrowseEdit; |
|
|
|
package Tk::BrowseEdit; |
|
|
|
|
|
|
|
|
|
|
|
use Tk; |
|
|
|
use Tk; |
|
|
|
use Tk::Font; |
|
|
|
use Tk::Font; |
|
|
|
use base 'Tk::Frame'; |
|
|
|
use base 'Tk::Frame'; |
|
|
|
|
|
|
|
|
|
|
|
use strict; |
|
|
|
use strict; |
|
|
|
use warnings; |
|
|
|
use warnings; |
|
|
|
|
|
|
|
|
|
|
|
Construct Tk::Widget 'BrowseEdit'; |
|
|
|
Construct Tk::Widget 'BrowseEdit'; |
|
|
|
|
|
|
|
|
|
|
|
sub ClassInit |
|
|
|
sub ClassInit |
|
|
|
{ |
|
|
|
{ |
|
|
|
my ($class, $mw) = @_; |
|
|
|
my ($class, $mw) = @_; |
|
|
|
$class->SUPER::ClassInit($mw); |
|
|
|
$class->SUPER::ClassInit($mw); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub Populate |
|
|
|
sub Populate |
|
|
|
{ |
|
|
|
{ |
|
|
|
my ($self, $args) = @_; |
|
|
|
my ($self, $args) = @_; |
|
|
@ -48,7 +53,10 @@ $self]); |
|
|
|
-font => $self->Font(-family => 'times', -size => '8'), |
|
|
|
-font => $self->Font(-family => 'times', -size => '8'), |
|
|
|
-command => [sub { |
|
|
|
-command => [sub { |
|
|
|
my ($self) = @_; |
|
|
|
my ($self) = @_; |
|
|
|
$self->toggleTag('<u>'); |
|
|
|
my $color = $self->chooseColor( |
|
|
|
|
|
|
|
-initialcolor => 'black', -parent => $self, |
|
|
|
|
|
|
|
-title => 'Choose Background Color'); |
|
|
|
|
|
|
|
$self->toggleTag("<font back=\"$color\">", '<back>'); |
|
|
|
}, $self] |
|
|
|
}, $self] |
|
|
|
)->pack(-pady => 0, -side => 'left', -fill => 'both'); |
|
|
|
)->pack(-pady => 0, -side => 'left', -fill => 'both'); |
|
|
|
$self->bind('<Control-U>', [sub { shift->{'<b>'}->invoke; }, $self]); |
|
|
|
$self->bind('<Control-U>', [sub { shift->{'<b>'}->invoke; }, $self]); |
|
|
@ -63,13 +71,16 @@ $self]); |
|
|
|
'to_html' => $self, |
|
|
|
'to_html' => $self, |
|
|
|
); |
|
|
|
); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub insert |
|
|
|
sub insert |
|
|
|
{ |
|
|
|
{ |
|
|
|
shift->{text}->insert(@_); |
|
|
|
shift->{text}->insert(@_); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub toggleTag |
|
|
|
sub toggleTag |
|
|
|
{ |
|
|
|
{ |
|
|
|
my ($self, $tag) = @_; |
|
|
|
my ($self, $tag, $button) = @_; |
|
|
|
|
|
|
|
$button = defined($button) ? $button : $tag; |
|
|
|
if(!defined($self->{text}->tagRanges('sel'))) |
|
|
|
if(!defined($self->{text}->tagRanges('sel'))) |
|
|
|
{ |
|
|
|
{ |
|
|
|
# no selection - modify current position |
|
|
|
# no selection - modify current position |
|
|
@ -88,7 +99,7 @@ sub toggleTag |
|
|
|
print "tag created\n"; |
|
|
|
print "tag created\n"; |
|
|
|
$self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']); |
|
|
|
$self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']); |
|
|
|
$self->tagAdd($cur_tag, 'insert'); |
|
|
|
$self->tagAdd($cur_tag, 'insert'); |
|
|
|
$self->{$tag}->configure(-relief => 'flat'); |
|
|
|
$self->{$button}->configure(-relief => 'flat'); |
|
|
|
print "done\n"; |
|
|
|
print "done\n"; |
|
|
|
} |
|
|
|
} |
|
|
|
else |
|
|
|
else |
|
|
@ -99,11 +110,16 @@ sub toggleTag |
|
|
|
$self->create_tag($cur_tag); |
|
|
|
$self->create_tag($cur_tag); |
|
|
|
$self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']); |
|
|
|
$self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']); |
|
|
|
$self->tagAdd($cur_tag, 'insert'); |
|
|
|
$self->tagAdd($cur_tag, 'insert'); |
|
|
|
$self->{$tag}->configure(-relief => 'sunken'); |
|
|
|
$self->{$button}->configure(-relief => 'sunken'); |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
else |
|
|
|
else |
|
|
|
{ |
|
|
|
{ |
|
|
|
|
|
|
|
my $removed; |
|
|
|
|
|
|
|
my $new_tag; |
|
|
|
|
|
|
|
for my $wholetag ($self->{text}->tagNames()) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
next unless $wholetag =~ /$tag/; |
|
|
|
my ($selstart, $selend) = $self->{text}->tagRanges('sel'); |
|
|
|
my ($selstart, $selend) = $self->{text}->tagRanges('sel'); |
|
|
|
my @tags = $self->{text}->tagRanges($tag); |
|
|
|
my @tags = $self->{text}->tagRanges($tag); |
|
|
|
my (@starts, @ends); |
|
|
|
my (@starts, @ends); |
|
|
@ -118,16 +134,24 @@ sub toggleTag |
|
|
|
{ |
|
|
|
{ |
|
|
|
if($selstart >= $start and $selend <= $end) |
|
|
|
if($selstart >= $start and $selend <= $end) |
|
|
|
{ |
|
|
|
{ |
|
|
|
$self->{text}->tagRemove($tag, $self->{text}->tagRanges('sel')); |
|
|
|
$new_tag .= $tag; |
|
|
|
$self->{$tag}->configure(-relief => 'flat'); |
|
|
|
$self->{$tag}->configure(-relief => 'flat'); |
|
|
|
|
|
|
|
$removed = 1; |
|
|
|
return; |
|
|
|
return; |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
unless($removed) |
|
|
|
|
|
|
|
{ |
|
|
|
|
|
|
|
$self->create_tag($new_tag); |
|
|
|
$self->{text}->tagAdd($tag, $self->{text}->tagRanges('sel')); |
|
|
|
$self->{text}->tagAdd($tag, $self->{text}->tagRanges('sel')); |
|
|
|
$self->{$tag}->configure(-relief => 'sunken'); |
|
|
|
$self->{$tag}->configure(-relief => 'sunken'); |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub create_tag |
|
|
|
sub create_tag |
|
|
|
{ |
|
|
|
{ |
|
|
|
my ($self, $tag) = @_; |
|
|
|
my ($self, $tag) = @_; |
|
|
|