in reply to Coloring text using TK?

In a Text widget, you can use tags to give properties to ranges of characters. You can either set them during insert, or attach them later. The code demonstrates both: 

#!/usr/bin/perl -w
use Tk;
my $top = MainWindow->new;

my $t = $top->Text();
$t->tagConfigure("boring",    -foreground => "blue");
$t->tagConfigure("special",   -foreground => "red");

$t->insert("end", "If you want to be immune from silly letters, don't 
+carry your momomark in your hat.\n");
$t->insert("end", "bij bij\n", "special");
$t->insert("end", "Zoem your Zoem\n", "boring");

my $word = "your";
my $word_len = length $word;
my $next = "1.0";
while (my $from = $t->search(-regexp, "\\b$word\\b", $next, "end")) {
    $next = "$from + $word_len chars";
    $t->tagAdd("special", $from, $next);
}

$t->pack;
MainLoop;

[download]

Replies are listed 'Best First'.
Re: Re: Coloring text using TK?
by Elijah (Hermit) on Dec 01, 2003 at 21:46 UTC
    That works great but what if I want to check for more than just one word? Is there a way I can maybe impplement an array or some sort of list and step through the list and color accordingly? It seems the more words I want to color the slower it will goes exponentially which is why I need to find the fastest way possible to color multiple words instead of just one.
[reply]
      Well, you can make a combined regex like '\b'.join("|",@words).'\b', but unfortunately that regex will be compiled every time (I tried with a qr//, but at least the Tk I use can't handle that). It's also annoying that you have to rediscover the wordlength to be able to determine the proper range. So you can make it work O(textlength*numberOfWords) which might be fast enough, but it indeed gets awkward.

      So doing it at text insertion time is probably simpler: 

      #!/usr/bin/perl -w
use strict;
use Tk;
my $top = MainWindow->new;

my $t = $top->Text();
$t->tagConfigure("boring",    -foreground => "blue");
$t->tagConfigure("special",   -foreground => "red");

# Change the match rule according to taste
my @words = qw(your be is silly);
my $regex = join("|", @words);
$regex = qr/(.*?)\b($regex)\b/s;

my $text = "If you want to be immune from silly letters, don't carry y
+our monomark in your hat.\n";

while ($text =~ /$regex/gc) {
    $t->insert("end", $1, "boring");
    $t->insert("end", $2, "special");
}
$t->insert("end", $1, "boring") if $text =~ /(.+)/gs;

$t->pack;
MainLoop;

      [download]
      This should avoid too many regex recompiles, and give perl a chance to build a good matcher. Maybe it's good enough for what you want ?

      If that's not good enough, one way might be to build a statemachine for the match by hand and operate on the characters as they come in at the same time as you are putting them in the widget. Though that's guaranteed linear time, it's quite a bit of work per character, so I don't expect it to win until you have a lot of words. It might be useable to handle userinput while he's typing though. Surprisingly I don't directly see a perl module on CPAN (using a search on "DFA") to generate such a statemachine from a set of words.

[reply]
[d/l]
[select]
        That is pretty sweet but all the text entered in manually is blue and is not interrogated for certain words. Is this what it is suppose to do? I only want certain words in the array to be colored on input.
[reply]
      Ok I actually found a way to shorten the code and combine multiple words into an array. It does not speed up the text coloring or parsing but it does not slow it down either. It is the exact same speed just less code then writing out every single word and corresponding parsing code. Here it is: 
                  my @words = ("sub", "if", "elsif", "else", "my", "use");
            foreach my $word (@words) {
               my $word_len = length $word;
               my $next = "1.0";
               while (my $from = $t->search(-regexp, "\\b$word\\b", $n
+ext, "end")) {
                  $next = "$from + $word_len chars";
                  $t->tagAdd("blue", $from, $next);
                  $t->tagAdd("bold", $from, $next);
               }
            }

      [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom