Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re: $_ is null in Tk:Scrolled search?

by bbfu (Curate)
on Dec 08, 2003 at 19:03 UTC ( #313185=note: print w/ replies, xml ) Need Help??


in reply to $_ is null in Tk:Scrolled search?

You use the Text's search function for the word, why not also for the comment?

Update: Modified slightly to only un/highlight current line, hopefully improving efficiency some.
Update2: Made functions slightly more modular, and fixed paste issue caused by previous update. Added style for comments. Added comment regexp global.
Update3: There's an issue w/ comments on lines w/o keywords. I'll fix it later.
Update4: Fixed the comment issue.

#!/usr/bin/winperl use strict; use warnings; use Tk; our @Keywords = qw( print sprintf ); our $Comment = '#|//'; our %Highlights = ( Keyword => [qw(red bold)], Comment => [qw(gray italic)], ); setup_window(); MainLoop; sub setup_window { my $mw = MainWindow->new(); my $t = $mw->Scrolled('Text', -font => ['Courier New', 10])->pack() +; $t->tagConfigure('red', -foreground => 'red'); $t->tagConfigure('gray', -foreground => 'gray'); $t->tagConfigure('green', -foreground => 'green'); $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 my include more than one line to be highlighted, # 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); # Highlight keywords foreach my $word (@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, 'Keyword'); } } } # Highlight comments my $next = $start; while (my $from = $t->search(-regexp => $Comment, $next, $end)) { $next = "$from lineend"; mark_word($t, $from, $next, '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); } }

bbfu
Black flowers blossom
Fearless on my breath


Comment on Re: $_ is null in Tk:Scrolled search?
Download Code
Re: Re: $_ is null in Tk:Scrolled search?
by Elijah (Hermit) on Dec 08, 2003 at 21:39 UTC
    Man that works sweet. Except the comments by themselves of course. I raped your code and implemented it in what I was doing and it works pretty good. It solved 2 of my problems at once. The commented text and the coloring on input. I am going to work on the comments by themselves in a little bit. I will post back if I come up with an answer. Edit 1:Got the code working with comments without keywords on same line.
    #!/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); } }
    Thanx again for the great input!

      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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://313185]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (8)
As of 2014-11-25 23:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (160 votes), past polls