From b3c38e67c2658c191127c221bf50df2b091d42dd Mon Sep 17 00:00:00 2001 From: milkbone57 Date: Thu, 21 Aug 2003 23:14:14 +0000 Subject: [PATCH] "" --- plugins/Tk-GUI/Tk/BrowseEdit.pm | 194 ++++++++++++++++++------------- plugins/Tk-GUI/Tk/ColorChoice.pm | 10 +- 2 files changed, 116 insertions(+), 88 deletions(-) diff --git a/plugins/Tk-GUI/Tk/BrowseEdit.pm b/plugins/Tk-GUI/Tk/BrowseEdit.pm index aa0d7ac..4366612 100644 --- a/plugins/Tk-GUI/Tk/BrowseEdit.pm +++ b/plugins/Tk-GUI/Tk/BrowseEdit.pm @@ -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; use Tk; use Tk::Font; -use Tk::ColorChoice; use base 'Tk::Frame'; use Data::Dumper; @@ -27,7 +41,6 @@ sub Populate -font => $self->Font(-family => 'times', -weight => 'bold', -size => '8'), -command => [sub { my ($self) = @_; - print "hit b\n"; $self->toggleTag(''); }, $self] )->pack(-pady => 0, -side => 'left', -fill => 'both'); @@ -51,11 +64,13 @@ $self]); )->pack(-pady => 0, -side => 'left', -fill => 'both'); $self->bind('', [sub { shift->{''}->invoke; }, $self]); - $self->{''} = $self->{panel}->Button(-text => 'A', -relief => 'flat', -background => 'blue', + $self->{''} = $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; + my $color = $self->pick_color; + return if $color eq "NOTACOLOR"; $self->toggleTag("", ''); }, $self] @@ -85,21 +100,19 @@ sub toggleTag 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->{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'); - print "done\n"; } else { @@ -107,51 +120,50 @@ sub toggleTag $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->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')); - print "Added $tag\n"; - $self->{$tag}->configure(-relief => 'sunken'); - } + 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'); + } } } @@ -172,14 +184,15 @@ sub create_tag { $fontparams{-slant} = 'italic'; } - if($tag =~ //) + if($tag =~ //) { - $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->{created_tags}->{$tag} = 1; + $self->{created_tags}->{$tag} = 1; } sub to_html { @@ -189,38 +202,51 @@ sub to_html 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')) + 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; + %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 "") + { + $pos = $self->{text}->index('0.0 + ' . ++$chars . " chars"); + $res .= $self->{text}->get($pos); + $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"); - } - $res =~ s/\%*ignore\%*//g; - return $res; + } + + my $chr = chr(255); + $res =~ s/$chr//g; + return $res; } sub end_tag { @@ -235,11 +261,11 @@ sub pick_color my $dlg = $self->Parent->DialogBox(-title => 'Choose Color', -buttons => ['OK', 'Cancel'], -default_button => 'OK'); - $dlg->ColorChoice->pack; + my $wid = $dlg->ColorChoice->pack; my $res = $dlg->Show(); - return unless $res eq "OK"; - + return "NOTACOLOR" unless $res eq "OK"; + return $wid->{color}; } 1; diff --git a/plugins/Tk-GUI/Tk/ColorChoice.pm b/plugins/Tk-GUI/Tk/ColorChoice.pm index d0c6150..c599ee9 100644 --- a/plugins/Tk-GUI/Tk/ColorChoice.pm +++ b/plugins/Tk-GUI/Tk/ColorChoice.pm @@ -36,8 +36,10 @@ black white); while(@colors and @currow < 4) { my $color = shift @colors; - push @currow, $self->Button(-background => $color, -activebackground => -$color, -text => ' ', -command => [$self, "on_click"]); + my $button = $self->Button(-background => $color, -activebackground => + $color, -text => ' '); + $button->configure(-command => [\&on_click, $self, $button]); + push @currow, $button; } last unless @currow; (shift @currow)->grid(@currow); @@ -46,8 +48,8 @@ $color, -text => ' ', -command => [$self, "on_click"]); sub on_click { - my ($self) = @_; - + my ($self, $button) = @_; + $self->{color} = $button->cget(-background); }