You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
273 lines
8.4 KiB
273 lines
8.4 KiB
# |
|
# |
|
# WARNING - THIS IS CHEWBACCA CODE - IT DOES NOT MAKE SENSE. DO NOT MAKE ANY |
|
# CHANGES TO THIS FILE, FOR IT FUNCTIONS IF AND ONLY IF THE CODE IS EXACTLY |
|
# AS IT IS AND EVEN THEN ONLY WORKS PROPERLY DURING A FULL MOON ON THE THIRD |
|
# THURSRDAY OF ODD-NUMBERED MONTHS IN THE SPRING WHEN THERE'S SNOW ON THE |
|
# GROUND. |
|
# |
|
# YOU HAVE BEEN WARNED. DO NOT BLAME ME IF THIS CODE DOES NOT WORK, EATS |
|
# YOUR CHILDREN, OR FAXES HUNDREDS OF COPIES OF ITSELF TO GUAM. |
|
# |
|
# IT DOES NOT MAKE SENSE!!!! (Look at the monkey, look at the silly monkey...) |
|
# |
|
# - batkins (8-21-03) |
|
# |
|
|
|
package Tk::BrowseEdit; |
|
|
|
use Tk; |
|
use Tk::Font; |
|
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(-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}->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 => 'back', -relief => 'flat', -background => 'blue', |
|
# -activebackground => 'blue', |
|
# -font => $self->Font(-family => 'times', -size => '8'), |
|
# -command => [sub { |
|
# my ($self) = @_; |
|
# my $color = $self->pick_color; |
|
# return if $color eq "NOTACOLOR"; |
|
# |
|
# $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 |
|
my $cur_tag = ($self->{text}->tagNames('insert'))[0] || ""; |
|
if ($cur_tag =~ /$tag/i) |
|
{ |
|
# tag is defined for this region - remove it |
|
|
|
return if $cur_tag eq ""; |
|
$self->{text}->tagRemove($cur_tag, 'insert'); |
|
$cur_tag =~ s/$tag//i; |
|
$self->create_tag($cur_tag); |
|
$self->{text}->tagAdd($cur_tag, 'insert'); |
|
$self->insert('insert', chr(255), [$cur_tag, 'elide']) if $cur_tag ne ""; |
|
$self->insert('insert', chr(255), ['elide']) if $cur_tag eq ""; |
|
$self->{$button}->configure(-relief => 'flat'); |
|
} |
|
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) unless $cur_tag eq ""; |
|
$self->insert('insert', chr(255), [$cur_tag, 'elide']) if $cur_tag ne ""; |
|
$self->insert('insert', chr(255), ['elide']) if $cur_tag eq ""; |
|
$self->{text}->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); |
|
return unless $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'; |
|
} |
|
if($tag =~ /<font back=('|")(.*?)('|")>/) |
|
{ |
|
$tagparams{-background} = $2; |
|
print "set background"; |
|
} |
|
|
|
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 = '0.0'; |
|
my $chars = 0; |
|
my ($curtag, $prevtag) = ("", ""); |
|
my %all_tags; |
|
|
|
while($self->{text}->index($pos) != $self->{text}->index('end')) |
|
{ |
|
%all_tags = (); |
|
$all_tags{$_} = $_ for $self->{text}->tagNames($pos); |
|
delete $all_tags{'sel'}; |
|
delete $all_tags{'elide'}; |
|
delete $all_tags{''}; |
|
|
|
if(scalar(keys %all_tags) == 0 && $prevtag eq "") |
|
{ |
|
$res .= $self->{text}->get($pos); |
|
$pos = $self->{text}->index('0.0 + ' . ++$chars . " chars"); |
|
$prevtag = ""; |
|
next; |
|
} |
|
|
|
$curtag = (keys %all_tags)[0] || ""; |
|
|
|
|
|
if($prevtag =~ /$curtag/) |
|
{ |
|
# tag added |
|
($temp = $prevtag) =~ s/$curtag//; |
|
$res .= end_tag($temp); |
|
} |
|
elsif($curtag =~ /$prevtag/) |
|
{ |
|
# tag removed |
|
($temp = $curtag) =~ s/$prevtag//; |
|
$res .= $temp; |
|
} |
|
|
|
$prevtag = $curtag; |
|
|
|
$res .= $self->{text}->get($pos); |
|
$pos = $self->{text}->index('0.0 + ' . ++$chars . " chars"); |
|
} |
|
|
|
my $chr = chr(255); |
|
$res =~ s/$chr//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'); |
|
|
|
my $wid = $dlg->ColorChoice->pack; |
|
my $res = $dlg->Show(); |
|
|
|
return "NOTACOLOR" unless $res eq "OK"; |
|
return $wid->{color}; |
|
} |
|
|
|
1;
|
|
|