archive
/
milkbone
1
0
Fork 0
Code Pull Requests Projects Releases Activity
Browse Source

""

master
milkbone57 22 years ago
parent
522daa426f
commit
b3c38e67c2
2 changed files with 116 additions and 88 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 186
      plugins/Tk-GUI/Tk/BrowseEdit.pm
  2. 10
      plugins/Tk-GUI/Tk/ColorChoice.pm

186
plugins/Tk-GUI/Tk/BrowseEdit.pm
Unescape View File

@ -1,8 +1,22 @@
#
#
# 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; package Tk::BrowseEdit;
use Tk; use Tk;
use Tk::Font; use Tk::Font;
use Tk::ColorChoice;
use base 'Tk::Frame'; use base 'Tk::Frame';
use Data::Dumper; use Data::Dumper;
@ -27,7 +41,6 @@ sub Populate
-font => $self->Font(-family => 'times', -weight => 'bold', -size => '8'), -font => $self->Font(-family => 'times', -weight => 'bold', -size => '8'),
-command => [sub { -command => [sub {
my ($self) = @_; my ($self) = @_;
print "hit b\n";
$self->toggleTag('<b>'); $self->toggleTag('<b>');
}, $self] }, $self]
)->pack(-pady => 0, -side => 'left', -fill => 'both'); )->pack(-pady => 0, -side => 'left', -fill => 'both');
@ -51,11 +64,13 @@ $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]);
$self->{'<back>'} = $self->{panel}->Button(-text => 'A', -relief => 'flat', -background => 'blue', $self->{'<back>'} = $self->{panel}->Button(-text => 'back', -relief => 'flat', -background => 'blue',
-activebackground => 'blue',
-font => $self->Font(-family => 'times', -size => '8'), -font => $self->Font(-family => 'times', -size => '8'),
-command => [sub { -command => [sub {
my ($self) = @_; my ($self) = @_;
my $color = $self->pick_color; my $color = $self->pick_color;
return if $color eq "NOTACOLOR";
$self->toggleTag("<font back=\"$color\">", '<back>'); $self->toggleTag("<font back=\"$color\">", '<back>');
}, $self] }, $self]
@ -85,21 +100,19 @@ sub toggleTag
if(!defined($self->{text}->tagRanges('sel'))) if(!defined($self->{text}->tagRanges('sel')))
{ {
# no selection - modify current position # no selection - modify current position
print "starting\n";
my $cur_tag = ($self->{text}->tagNames('insert'))[0] || ""; my $cur_tag = ($self->{text}->tagNames('insert'))[0] || "";
print "tag names gotten\n";
if ($cur_tag =~ /$tag/i) if ($cur_tag =~ /$tag/i)
{ {
# tag is defined for this region - remove it # tag is defined for this region - remove it
return if $cur_tag eq ""; return if $cur_tag eq "";
$self->{text}->tagRemove($cur_tag, 'insert'); $self->{text}->tagRemove($cur_tag, 'insert');
print "tagremove $cur_tag\n";
$cur_tag =~ s/$tag//i; $cur_tag =~ s/$tag//i;
$self->create_tag($cur_tag); $self->create_tag($cur_tag);
$self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']); $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'); $self->{$button}->configure(-relief => 'flat');
print "done\n";
} }
else else
{ {
@ -107,51 +120,50 @@ sub toggleTag
$self->{text}->tagRemove($cur_tag, 'insert'); $self->{text}->tagRemove($cur_tag, 'insert');
$cur_tag .= $tag; $cur_tag .= $tag;
return unless $cur_tag && $cur_tag ne ""; return unless $cur_tag && $cur_tag ne "";
$self->create_tag($cur_tag); $self->create_tag($cur_tag) unless $cur_tag eq "";
$self->insert('insert', '%%%ignore%%%', [$cur_tag, 'elide']); $self->insert('insert', chr(255), [$cur_tag, 'elide']) if $cur_tag ne "";
$self->tagAdd($cur_tag, 'insert'); $self->insert('insert', chr(255), ['elide']) if $cur_tag eq "";
print "tagadd $cur_tag\n"; $self->{text}->tagAdd($cur_tag, 'insert');
$self->{$button}->configure(-relief => 'sunken'); $self->{$button}->configure(-relief => 'sunken');
} }
} }
else else
{ {
my $removed; my $removed;
my $new_tag; my $new_tag;
for my $wholetag ($self->{text}->tagNames()) for my $wholetag ($self->{text}->tagNames())
{ {
next unless $wholetag =~ /$tag/; 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);
for(my $i = 0; $i < @tags; $i += 2) for(my $i = 0; $i < @tags; $i += 2)
{ {
push @starts, $tags[$i]; push @starts, $tags[$i];
push @ends, $tags[$i + 1]; push @ends, $tags[$i + 1];
} }
for my $start (@starts) for my $start (@starts)
{ {
for my $end (@ends) for my $end (@ends)
{ {
if($selstart >= $start and $selend <= $end) if($selstart >= $start and $selend <= $end)
{ {
$new_tag .= $tag; $new_tag .= $tag;
$self->{$tag}->configure(-relief => 'flat'); $self->{$tag}->configure(-relief => 'flat');
$removed = 1; $removed = 1;
return; return;
} }
} }
} }
} }
unless($removed) unless($removed)
{ {
$self->create_tag($new_tag); self->create_tag($new_tag);
return unless $tag; return unless $tag;
$self->{text}->tagAdd($tag, $self->{text}->tagRanges('sel')); $self->{text}->tagAdd($tag, $self->{text}->tagRanges('sel'));
print "Added $tag\n"; $self->{$tag}->configure(-relief => 'sunken');
$self->{$tag}->configure(-relief => 'sunken'); }
}
} }
} }
@ -172,14 +184,15 @@ sub create_tag
{ {
$fontparams{-slant} = 'italic'; $fontparams{-slant} = 'italic';
} }
if($tag =~ /<font back='(.*?)'>/) if($tag =~ /<font back=('|")(.*?)('|")>/)
{ {
$fontparams{-slant} = 'italic'; $tagparams{-background} = $2;
print "set background";
} }
my $font = $self->Font(%fontparams); my $font = $self->Font(%fontparams);
$self->tagConfigure($tag, %tagparams, -font => $font); $self->tagConfigure($tag, %tagparams, -font => $font);
$self->{created_tags}->{$tag} = 1; $self->{created_tags}->{$tag} = 1;
} }
sub to_html sub to_html
{ {
@ -189,38 +202,51 @@ sub to_html
my ($res, $temp); my ($res, $temp);
my $pos = '1.0'; my $pos = '1.0';
my $chars = 0; my $chars = 0;
my ($curtag, $prevtag) = ("", ""); my ($curtag, $prevtag) = ("", "");
my %all_tags; my %all_tags;
while($self->{text}->index($pos) != $self->{text}->index('end'))
while($self->{text}->index($pos) != $self->{text}->index('end'))
{ {
print Dumper([$self->{text}->tagNames($pos)]) . "\n"; %all_tags = ();
$all_tags{$_} = $_ for $self->{text}->tagNames($pos); $all_tags{$_} = $_ for $self->{text}->tagNames($pos);
delete @all_tags{'elide', 'sel', ''}; delete $all_tags{'sel'};
delete $all_tags{'elide'};
delete $all_tags{''};
if(scalar(keys %all_tags) == 0 && $prevtag eq "")
{
$pos = $self->{text}->index('0.0 + ' . ++$chars . " chars");
$res .= $self->{text}->get($pos);
$prevtag = "";
next;
}
$curtag = (keys %all_tags)[0]; $curtag = (keys %all_tags)[0] || "";
print Dumper(\%all_tags);
print $self->{text}->get($pos) . "\n";
if($curtag =~ /$prevtag/) if($prevtag =~ /$curtag/)
{ {
($temp = $curtag) =~ s/$prevtag//; # tag added
$res .= $temp; ($temp = $prevtag) =~ s/$curtag//;
} $res .= end_tag($temp);
else }
{ elsif($curtag =~ /$prevtag/)
($temp = $prevtag) =~ s/$curtag//; {
$res .= end_tag($temp); # tag removed
} ($temp = $curtag) =~ s/$prevtag//;
$res .= $temp;
}
$prevtag = $curtag; $prevtag = $curtag;
$res .= $self->{text}->get($pos); $res .= $self->{text}->get($pos);
$pos = $self->{text}->index('0.0 + ' . ++$chars . " chars"); $pos = $self->{text}->index('0.0 + ' . ++$chars . " chars");
} }
$res =~ s/\%*ignore\%*//g;
return $res; my $chr = chr(255);
$res =~ s/$chr//g;
return $res;
} }
sub end_tag sub end_tag
{ {
@ -235,11 +261,11 @@ sub pick_color
my $dlg = $self->Parent->DialogBox(-title => 'Choose Color', -buttons => my $dlg = $self->Parent->DialogBox(-title => 'Choose Color', -buttons =>
['OK', 'Cancel'], -default_button => 'OK'); ['OK', 'Cancel'], -default_button => 'OK');
$dlg->ColorChoice->pack; my $wid = $dlg->ColorChoice->pack;
my $res = $dlg->Show(); my $res = $dlg->Show();
return unless $res eq "OK"; return "NOTACOLOR" unless $res eq "OK";
return $wid->{color};
} }
1; 1;

10
plugins/Tk-GUI/Tk/ColorChoice.pm
Unescape View File

@ -36,8 +36,10 @@ black white);
while(@colors and @currow < 4) while(@colors and @currow < 4)
{ {
my $color = shift @colors; my $color = shift @colors;
push @currow, $self->Button(-background => $color, -activebackground => my $button = $self->Button(-background => $color, -activebackground =>
$color, -text => ' ', -command => [$self, "on_click"]); $color, -text => ' ');
$button->configure(-command => [\&on_click, $self, $button]);
push @currow, $button;
} }
last unless @currow; last unless @currow;
(shift @currow)->grid(@currow); (shift @currow)->grid(@currow);
@ -46,8 +48,8 @@ $color, -text => ' ', -command => [$self, "on_click"]);
sub on_click sub on_click
{ {
my ($self) = @_; my ($self, $button) = @_;
$self->{color} = $button->cget(-background);
} }

Write Preview
Loading…
Cancel
Save