Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

$_ is null in Tk:Scrolled search?

by Elijah (Hermit)
on Dec 08, 2003 at 17:04 UTC ( #313143=perlquestion: print w/ replies, xml ) Need Help??
Elijah has asked for the wisdom of the Perl Monks concerning the following question:

I need a little clerification on a function of this widget if anyone knows.
@words = ("print", "sprintf"); foreach my $word (@words) { 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"; if ($_ =~ /\#/) { my @comment = split(//, $_); my $i = 0; foreach my $comment (@comment) { if ($comment eq "#") { my $offset = $i; if ($from < $offset) { $t->tagAdd("red", $from, $next); } }else{ $i++; } } }else{ $t->tagAdd("red", $from, $next); $t->tagAdd("bold", $from, $next); } } }
The issue is with the "if" statement checking to see if $_ matches a # character. I thought I could reference $_ while the "search" function of the "Scrolled" widget was being traversed but it appears that $_ is empty during this process so of course it will never match a # character. Anyone know what this search function references as the current string so I can implement this?

Comment on $_ is null in Tk:Scrolled search?
Download Code
Re: $_ is null in Tk:Scrolled search?
by rinceWind (Monsignor) on Dec 08, 2003 at 17:22 UTC
    I think you have already found your bug here. Why would you expect $_ to be varying while this code is being executed. The outermost foreach binds $word to each member of @words, and the while statement is checking the value of $from.

    So, you tell me what the purpose of the if statement is.

    --
    I'm Not Just Another Perl Hacker
      I understand that $from returns an integer value representing the line number and character number of the first character in the latched word. However I need a way to search each string the "search" function in the while loop is searching so I can check for a comment character. Maybe I can just add this check to the while loop statement. Basically I need to check if a commented string is on the same line as the found matched $word. If it is I am sure you can see from my code what I want to do. If not I simply want to test if the coordinates of the comment character is after the $from of the matched word. If it is after then I know it is safe to color the matched word it's corresponding color. If the matched word is after a comment character (meaning it is part of a commented string) then I do not want to color it.
Re: $_ is null in Tk:Scrolled search?
by converter (Priest) on Dec 08, 2003 at 18:49 UTC

    For clarity, you should probably be inquiring about Tk::Text or Tk::ROText, not Tk::Scrolled. Scrolled is just a wrapper that adds scrollbars and fillers.

Re: $_ is null in Tk:Scrolled search?
by bbfu (Curate) on Dec 08, 2003 at 19:03 UTC

    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

      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: perlquestion [id://313143]
Approved by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2014-11-22 00:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (118 votes), past polls