#!/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;
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);
}
}
| [reply] [d/l] |