I've extracted this code, from the rest of the code for an appli. I am working on.#!/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;
In the file against which we need to check,suppose:test.txt hi hello hey there
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.list.txt hi hello way to go
In reply to Re: Re: Tk text widget and strings
by perl_seeker
in thread Tk text widget and strings
by perl_seeker
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |