Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
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

Replies are listed 'Best First'.
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?
[stevieb]: choroba my GPS home device is done, at least prototype v1 is. I'm just making sure all of my code does what it says now
[stevieb]: I test/prototype code on my Pi, then I migrate it over to Arduino when it's ready (if that's a better platform for what I'm doing). The whole RPi stuff was for learning at first, then it snowballed. I'm just trying to get my in-house CI...
[stevieb]: ...done, which obviously requires a specific hardware setup.
[stevieb]: I don't write tests for the lower-level distributions (ie. ICs, sensors etc) within those distributions, I have all tests in a master distribution which encompasess all of the sub-modules

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (6)
As of 2017-06-25 22:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How many monitors do you use while coding?















    Results (572 votes). Check out past polls.