in reply to Re: Tk text widget and strings
in thread Tk text widget and strings

Hi,
sorry for the delayed reply. Had to try a few things first.I could not run the widget demo,I have perl v5.6.1, I'll have to install v5.8.0 first.And also Tk version 804, I've got version 800.023.

I could not in particular find this section "5. A search tool built with a text widget", your link led to a
download of search.pl, and nothing happened when I executed the script. I still have to go through the code of search.pl.

Here is my code(quite long)I had to extract it from the rest of my application: 

#!/usr/local/bin/perl -w

use Tk;
use Tk::Label;
use Tk::LabEntry;

our($filename, $info);                 

#Variables to be used in the subs &load_file and &save_file.$filename 
+stores the file name typed by the user in the entry widget of the mai
+n window.

#$info stores the text message displayed at the bottom of the main win
+dow.
                                       
my $mw = MainWindow->new;              # Main window.    

# Create necessary widgets.
                                       
my $f = $mw->Frame->pack(-side => 'top', -fill => 'x');               
+                #Create frame.

$f->Label(-text => "Filename:")->pack(-side => 'left', -anchor => 'w')
+;                        # Label widget.

$f->Entry(-textvariable => \$filename)->pack(-side => 'left', -anchor 
+=> 'w', -fill => 'x', -expand => 1); 
                                       # Entry widget.
                                                                      
+                             #Button widgets.
$f->Button(-text => "Save", -command =>\&save_file)->pack(-side => 'ri
+ght', -anchor => 'e');

$f->Button(-text => "Ignore",-command =>\&ignore)->pack(-side => 'righ
+t', -anchor => 'e');

$f->Button(-text => "Add?",-command =>\&addit)->pack(-side => 'right',
+ -anchor => 'e');

$f->Button(-text => "Sug", -command =>\&tged)->pack(-side => 'right');
+ 

$f->Button(-text => "Det",-command =>\&detect)->pack(-side => 'right',
+ -anchor => 'e');

$f->Button(-text => "Load", -command =>\&load_file)->pack(-side => 'ri
+ght', -anchor => 'e');

$mw->Label(-textvariable => \$info, -relief => 'ridge')->pack(-side =>
+ 'bottom', -fill => 'x');     # Label widget.
                                                        #Text widget.

my $t = $mw->Scrolled("Text",-font=>"{as-ttdurga} 24 {bold}")->pack(-s
+ide => 'bottom', -fill => 'both', -expand => 1);

MainLoop;

#load_file checks to see
#what the filename is and loads it if possible

sub load_file {
    $info = "Loading file '$filename'...";
    $t->delete("1.0", "end");        

#Delete contents of the text widget window.

    if (!open(FH, "$filename")) {

    $t->insert("end", "ERROR: Could not open $filename\n"); 

    #Error message to be displayed in the text  
    #widget window,  

    return;                                                
    #if the named file cannot be opened.
    }

     while (<FH>) { $t->insert
     ("end",$_); }                      

    #Insert contents of file into text widget window.

    close (FH);
    $info = "File '$filename' loaded";
    }


    # save_file saves the file 
    #using the filename in the Entry box.

 sub save_file {
    $info = "Saving '$filename'";
    open (FH, ">$filename");
    print FH $t->get("1.0", "end");    

    #Save contents of text widget window onto the 
    #appropriate file handle.      

    $info = "Saved.";
    }


sub chfile
  {
 
  my $mitem;     
  #An element of @missing.                      

  my $x;          
  my $y;                             

 #Line and char nos. where                  
 #the pattern ** is found.   

 my $z;                               
 #Character at one pos. ahead of $y.

 my $start_pt;                        
 #Start position from which to read character.
    
 my $end_pt;                         
 #End position upto which to read character.    

 my $y_orig;                          
 #Stores the initial value of character no. when a match is 
 #found.

 my $result;                          
 #The start pos. of the pattern **.
    
 open LEX, 'list.txt' or die $!;     
 #Open dictionary file.   

 my %lexicon;                       
 #Hash for storing dictionary words.
  
  while(<LEX>){
  chomp;
  my @words =split;                  
  #Split words on whitespace and store in @words.

  @lexicon{@words} = (1) x @words;     

  #Hash slice in which, the words in @words are the keys 
  #and the values are all 1.
  }
  
  close LEX;
  
  open FILE, "+<$filename" or die $!;  
  #Open the file containing text 

  my @missing;                         
  #Array for holding words not found in the dictionary.

  my @data;                           
  #Array containing all words in the file.
  
  while(<FILE>){
  push @missing, grep { ! $lexicon{$_} } split; 

  #Compare each word in the file to see, if there is a hash 
  #entry with that word as key.If not, push word onto 
  #@missing.

  push @data,split; 
  }
  
  foreach $mitem(@missing){
  
     $mitem=~ tr/""//d;              
     #Remove opening double quotes.

     $mitem=~ tr/''//d;              
     #Remove closing double quotes.

     $mitem=~ tr/?//d;               #Remove question mark.
     $mitem=~ tr/,//d;               #Remove comma.
     $mitem=~ tr/.//d;               #Remove period. 
     $mitem=~ tr/-//d;               #Remove hyphen.   

     $mitem=~ tr/(//d;               
     #Remove opening round  bracket.

     $mitem=~ tr/)//d;               
     #Remove closing round bracket.

     $mitem=~ tr/"//d;               
     #Remove opening single quote.

     $mitem=~ tr/'//d;               
     #Remove closing single quote.

     $mitem=~ tr/!//d;               
     #Remove exclamation mark.

     #$mitem=~ tr/*//d;              
     #Remove full stop(dari).
     
     #print "\nThe token after removing punctuation marks:";
     #print "\n$mitem\n";
          
       }   
          
       #print "\n@missing";
       #print "\n@data";
       
       seek FILE, 0, 0; # go to start of file 
         truncate FILE, 0; 
                                          
             foreach $ditem(@data){
                 $_ = process($_); 
                 print FILE;          
                         #Re-write all words that were 
                         #originally in the file.     

                     print FILE " ";
                     foreach $mitem(@missing) { 
                           my $currentposition=tell FILE; 

                        #The current position of the     
                        #file pointer. 
 
                          seek FILE,0,1 ;               
                             #Move to current position.

                      if ($mitem eq $ditem)
                           { 
                      
                            #If a word in the 
                            #@missing array matches 
                            #any word in the file.

                          syswrite FILE,"**",4 ;         

                            #Insert some chars next to the 
                            #word to mark it.
                             
                         #print"\nThe misspelled words:";
                       #print"\n$mitem";

                         &load_file;
                                                       
                               } 
                            }             
                         }
     
        #print "\n@missing"; 
                 
        foreach $mitem(@missing) { 
                             
            #print"\nThe misspelled words:";
            #print"\n$mitem\n";
                               
            $result=$t->search(-forwards,"**",'end');
            #$result= '' unless defined $result;
            #print"\nThe start pos. of the pattern:";
            #print "\n$result";        #1.4
                                                                
            ($x, $y) = split '\.' => $result;             

            #Split string on . and store line no. in $x
            #(numeric value),character no. in $y(numeric 
            #value).

            #print "\nThe value of x:";                  
            #print "\n$x"; 
                              
            #Two character positions after $y.
            #print "\nThe value of y:";
            #print "\n$y";
            
            $y_or=$y+2; 
            $y -= 1;    
            
            $y_orig=$y;
            #print "\n$y_orig";
                        
            #print "\n$x";                
            #print "\n$y";
                        
            $z=$y - 1;
            #print $z;
                          
        for( 1 .. 15 ){
                  
        $start_pt="$x.$z"unless $z=~ /\-+d*/;      

            #$start_pt is a string value, obtained by      
            #concatenating two numeric values, $x and $z, 
            #unless $z is a -ve number.
    

       #print "\nThe start point:"; 
           #print " $start_pt ";
       $z--;    
                
       $end_pt="$x.$y" unless $y=~ /\-+d*/; 

           #$end_pt is a string value, obtained by 
           #concatenating two numeric values, $x and 
           #$y, unless $y is a -ve number.
       
       #print "\nThe end point:";   
           #print " $end_pt ";
       $y--;
                
           my $char_read=$t->get("$start_pt","$end_pt");
           #Read character from $start_pt to $end_pt.

           $char_read= '' unless defined $char_read;    
           #Set $char_read to one whitespace character 
           #if not defined.

           #print "\nThe character:";
           #print "\n$char_read";                              

           #@chars=$t->get("$start","$start wordend");
       my @chars;
       
           push @chars,$char_read;                          

           #Push characters read onto @chars.   
           #print "\n@chars";
       last if ($char_read =~ /\s/);  
                  
           #Exit loop i.e. stop reading characters if a 
           #whitespace character is encountered.

             }                                                        
+                             
                #print "\n@chars";
                #print "\n$end_pt";    
                                      
                my $p=".";
                    $p= '' unless defined $p;
                my $start=
                    $x.$p.$y_orig;                      

                    #The start index from which tag is to 
                    #be applied.

                #print "\nThe start of the word index:";
                #print "\n$start";
                                                  
                $t->tagConfigure  
                    ("wrong",foreground=>"red");  

                    #Tag to set text font colour to red.    
                $t->tagAdd("wrong","$end_pt","$start"); 

                    #Add tag to text between appropriate    
                    #indices.      
                             
                    my $del_pt=
                    $x.$p.$y_or;                        

                    #The index upto which characters are to 
                    #be deleted.

                #print "\nHere:";
                #print "\n$del_pt";
            
                    $t->delete("$result","$del_pt"); 
                
                close FILE;
                &save_file;
                                   
                 
           }  
           
           for(1..200){
           
             #print "\nThe misspelled word:";
             #print "\n$mitem\n";
             
             my $p=".";
             $p= '' unless defined $p;
                                       
                 my $result2=$t->search(-
                 forwards,"**",'end'); 

                 #Search for any occurences of the pattern  
                 #** in the text widget window.

             #$result2 = '' unless defined 
                  $result2;         

              #print "\nThe value of 
                  result2:";               
              #print "\n$result2\n";
                        
              my($p1, $p2) = split '\.' => $result2;
              #print "\nThe value of p1:";
              #print "\n$p1";
              #print "\nThe value of p2:";
              #print "\n$p2";
              $p1 = '' unless defined $p1;
              $p2 = '' unless defined $p2;
              $p2 += 2;
                     
              my $del_pt2=$p1.$p.$p2;
              $del_pt2 = '' unless defined $del_pt2;
                        
              $t->delete
                  ("$result2","$del_pt2");              
                  #Delete pattern.
                 
           }
            
         }                     
        
         1;           
                         
        
        sub process {  
        
            return($ditem);
              
            }
         
        1;

[download]
I've extracted this code, from the rest of the code for an appli. I am working on.

I wrote this code to work with text in the the Indic font AS-TTDurga.

Suppose we have in the text file to be checked: 
test.txt

hi 
hello
hey
there

[download]
In the file against which we need to check,suppose: 
list.txt

hi 
hello
way 
to 
go

[download]
The words 'hey' and 'there' in test.txt are not present in list.txt. So they should be marked in red, when the user clicks the 'Det' button(the callback function &chfile is invoked).The code works upto here, but sometimes words which are not present in list.txt do not get marked.

When we add the words 'hey' and 'there' to list.txt, the next time the user clicks on the 'Det' button,they should no longer be marked in red.But they get marked in red again.

Any suggestion will be appreciated. Sorry about the code formatting.
:) perl_seeker.

In Section Seekers of Perl Wisdom