#!/usr/bin/winperl
use strict;
use warnings;

use Tk;

our @Red_Keywords = qw(print sprintf);

our @Blue_Keywords = qw(if elsif else my our use sub);

our $Comment = '#|//';

our @Comment = ("\#", "\//");

our $All_Keys = "print|sprintf|if|elsif|else|my|our|use|sub|while|fore
+ach|loop|split|
                 glob|substr|length|open|close|chomp|chop|next|unless"
+;

our %Highlights = (
  Red_Keyword  => [qw(red bold)],
  Blue_Keyword => [qw(blue bold)],
  Comment      => [qw(orange italic)],
);

setup_window();

MainLoop;



sub setup_window {
  my $mw = MainWindow->new();
  my $t  = $mw->Scrolled('Text', -font => ['Courier New', 10])->pack()
+;

  $t->tagConfigure('blue',   -foreground => 'blue');
  $t->tagConfigure('red',    -foreground => 'red');
  $t->tagConfigure('orange', -foreground => 'orange');
  $t->tagConfigure('gray',   -foreground => 'gray');

  $t->tagConfigure('bold',   -font => ['Courier New', 10, 'bold']);
  $t->tagConfigure('italic', -font => ['Courier New', 10, 'italic']);

  $t->bind(
    '<KeyRelease>',
    # Automatically prepends $t to called sub's args
    [\&highlight_range, 'insert linestart', 'insert lineend'],
  );

  # Paste events may include more than one line to be formatted,
  # so we rehighlight the entire text.
  $t->bind(
    '<<Paste>>',
    [\&highlight_range, '1.0', 'end'],
  );

  $t->focus();
}

# Remove all formatting so that updates will unhighlight things proper
+ly
sub unhighlight_range {
  my $t     = shift;
  my $start = shift;
  my $end   = shift;

  foreach my $style (keys %Highlights) {
    foreach my $tag (@{$Highlights{$style}}) {
      $t->tagRemove($tag, $start, $end);
    }
  }
}

sub highlight_range {
  my $t     = shift;
  my $start = shift;
  my $end   = shift;

  unhighlight_range($t, $start, $end);

  foreach my $comm (@Comment) {
     my $word_len = length $comm;
     my $next = $start;
     while (my $comment = $t->search(-regexp => $comm, $next, $end)) {
        $next = "$comment + $word_len chars";

        # Search for a keyword on the same line
      
        my $from = $t->search(-regexp, "\\b\Q$All_Keys\E\\b", "$commen
+t linestart" => "$comment lineend");
     
        if($comment and !$from) {
           mark_word($t, $comment, "$comment lineend", 'Comment');
        }
     }
  }

  foreach my $word (@Red_Keywords) {
    my $word_len = length $word;
    my $next = $start;
    while (my $from = $t->search(-regexp, "\\b\Q$word\E\\b", $next, $e
+nd)) {
      $next = "$from + $word_len chars";

      # Search for a comment character on the same line
      my $comment = $t->search(
        -regexp => $Comment,
        "$from linestart" => "$from lineend"
      );

      # If comment found and is before keyword, skip formatting
      unless($comment and $t->compare($comment, '<', $from)) {
        mark_word($t, $from, $next, 'Red_Keyword');
      }

      if($comment) {
        mark_word($t, $comment, "$comment lineend", 'Comment');
      }
    }
  }

  foreach my $word (@Blue_Keywords) {
    my $word_len = length $word;
    my $next = $start;
    while (my $from = $t->search(-regexp, "\\b\Q$word\E\\b", $next, $e
+nd)) {
      $next = "$from + $word_len chars";

      # Search for a comment character on the same line
      my $comment = $t->search(
        -regexp => $Comment,
        "$from linestart" => "$from lineend"
      );

      # If comment found and is before keyword, skip formatting
      unless($comment and $t->compare($comment, '<', $from)) {
        mark_word($t, $from, $next, 'Blue_Keyword');
      }

      if($comment) {
        mark_word($t, $comment, "$comment lineend", 'Comment');
      }
    }
  }
}

sub mark_word {
  my $text  = shift;
  my $start = shift;
  my $end   = shift;
  my $style = shift;

  return unless exists $Highlights{$style};

  foreach my $tag (@{$Highlights{$style}}) {
    $text->tagAdd($tag, $start, $end);
  }
}
[download]

I fixed the comment problem. The whole thing is still a little inefficient, I think. If you type at the end of a line with a comment on it, you can see the character appear in black, then change to gray. *shrug*

If you are writing a syntax highlighter, as it appears, keep in mind that it's more difficult than it first appears. You have to keep in mind the possibility of comments and keywords appearing within strings, among many other subtleties. See On Parsing Perl, and my Syntax::Highlight::Perl for some more info.

bbfu
Black flowers blossom
Fearless on my breath