view release on metacpan or  search on metacpan

tkispell  view on Meta::CPAN

#!/usr/bin/perl -w

use Tk;
use Tk::widgets qw(Label Dialog SimpleFileSelect Balloon);

$VERSION=0.17;

#
# Default font - edit this for your system.
#
my $fn = '*-helvetica-medium-r-*-*-12-*'; # Widget font

my $lang = $ENV{LANG};
if ($lang =~ /^C$/ || ! defined ($lang)) {$lang = 'default'; }
my $hdict = $ENV{HOME}."/.ispell_$lang"; # Personal dictionary. 

my $ispell_prog = `which ispell`;  
chomp $ispell_prog;
my ($cw, $b1, @misspelledlist, @replacementlist, @addlist, $midx);
my $ifname = '';
my $lastmatchindex = '1.0';
my $matchlength = 0;
my $nextmiss = 0;
my $scriptname = $O;

sub mainwindow {
    $cw = new MainWindow (-title => $O);
    $b1 = $cw -> Balloon ();
    @opts = (-padx => 5, -pady => 5);
    my $cl = $cw->Scrolled ('Text', -height => 3, -wrap => 'none', 
	   -font => $fn, -scrollbars => 'se');
    $b1 -> attach ($cl, -balloonmsg => 'Misspelled text.');
    $cl->Subwidget($_)->configure(-width=>10) foreach('xscrollbar','yscrollbar'); 
    $cl->grid (-row => 2,-column => 1,-columnspan => 3,-sticky => 'ew',@opts);
    $cw->Advertise ('text' => $cl);
    my $lb = $cw -> Scrolled ('Listbox', -font => $fn, -scrollbars => 'osoe');
    $lb->grid(-row => 3,-column => 1,-columnspan => 2,-sticky => 'ew',@opts);
    $cw->Advertise('list' => $lb);
    $b1 -> attach ($lb, -balloonmsg => 'Selection of replacement words.');
    my $f = $cw->Frame(-container => 0)->grid(-row => 3,-column => 3);
    my $b = $cw->Button (-text => 'Accept',-command => sub {checknext ()},
			-width => 15, -font => $fn);
    $b->grid(-row => 1, -column => 1, -in => $f, -sticky => 'w', @opts);
    $b1 -> attach ($b, -balloonmsg => 'Accept the misspelled word.');
    $b = $cw->Button(-text => 'Add', -command => sub {push 
       @addlist, (gettextselection ()); checknext ()}, 
		     -width => 15, -font => $fn);
    $b->grid(-row => 2, -column => 1, -in => $f, -sticky => 'w', @opts);
    $b1 -> attach ($b, -balloonmsg => 'Add the misspelled wordto dictionary.');
    $b = $cw->Button(-text => 'Replace', -command => 
      sub{replace () && checknext ()}, -width => 15, -font => $fn);
    $b1 -> attach ($b, -balloonmsg => 'Replace this misspelling.');
    $b->grid(-row => 3, -column => 1, -in => $f, -sticky => 'w', @opts);
    $b = $cw->Button(-text => 'Replace All', -command => 
      sub {replaceall () ; checknext ()}, -width => 15, -font => $fn);
    $b->grid(-row => 4, -column => 1, -in => $f, -sticky => 'w', @opts);
    $b1 -> attach ($b, -balloonmsg => 'Replace all occurrences of misspelling.');
    my $l = $cw->Label (-text => 'Replace with:', -font => $fn, -width => 15);
    $l->grid(-row => 5, -column => 1, -padx => 5, -in => $f, -sticky => 'w');
    my $e = $cw->Entry (-width => 20);
    $e->grid(-row => 6, -column => 1, -padx => 5, -in => $f, -sticky => 'ew');
    $cw->Advertise ('replaceentry' => $e);
    $b1 -> attach ($e, -balloonmsg => 'Edit and replace the misspelling.');
    $lb -> bind ('<Button-1>', sub { $e->delete (0,'end');
		       $e->insert(0, $lb->get ($lb->curselection))});
    $f2 = $cw->Frame(-container => 0);
    $f2->grid (-row => 5, -column => 1, -columnspan => 4, -sticky => 'ew');
    $b = $cw->Button(-text => 'Check...', -command => sub {checkfirst ()},
			-width => 15, -font => $fn);
    $b1 -> attach ($b, -balloonmsg => 'Begin spell check.');
    $b -> grid (-row => 5, -column => 1, -sticky => 'ew', -in => $f2, @opts);
    $b = $cw -> Button (-text => 'Select File...', 
         -command => sub {selectfile ()},-width => 15, -font => $fn);
    $b1 -> attach ($b, -balloonmsg => 'Select file to spell check.');
    $b -> grid (-row => 5, -column => 2, -sticky => 'ew', -in => $f2, @opts);
    $b = $cw -> Button (-text => 'Dismiss', -command => sub{save_and_exit ()},
			-width => 15, -font => $fn);
    $b -> grid (-row => 5, -column => 3, -sticky => 'ew', -in => $f2, @opts);
    $b1 -> attach ($b, -balloonmsg => 'Exit the program.');
}

sub save_and_exit {
    $cw -> WmDeleteWindow if (defined ($ifname) && ! length ($ifname));
    if ($#misspelledlist >= 0) {
	my $d = $cw -> Dialog (-title => 'Save File',
           -text => "Save $ifname?\nOriginal file will be saved as $ifname.bak.", 
           -bitmap => 'question', -font => $fn, -buttons => [qw/Yes No/], 
           -default_button => 'Yes');
	$d -> Subwidget ('B_Yes') -> configure (-font => $fn);
	$d -> Subwidget ('B_No') -> configure (-font => $fn);
	if (($d->Show) =~ /Yes/) {
	    $cw -> Busy;
	    system ('mv', $ifname, "$ifname.bak");
	    open OUT, "+>>$ifname" or die "Couldn't overwrite old $ifname: $!\n";
	    print OUT ($cw -> Subwidget ('text') -> get ('1.0', 'end'));
	    close OUT;
	    $cw -> Unbusy;
	}
    }
    if ($#addlist >= 0) {
	$d = $cw -> Dialog (-title => 'Add Words',
	    -text => 'Save new words to your personal dictionary?',
            -bitmap => 'question', -font => $fn,
		-buttons => [qw/Yes No/], -default_button => 'Yes');
	$d -> Subwidget ('B_Yes') -> configure (-font => $fn);
	$d -> Subwidget ('B_No') -> configure (-font => $fn);
	if (($d->Show) =~ /Yes/) {
	  $cw -> Busy;
	  open OUT, ">>$hdict" or  die "Couldn't add words to $hdict: $!\n";
	  foreach (@addlist) { print OUT "$_\n"}
	  close OUT;
	  $cw -> Unbusy;
      }
    }
    $cw -> WmDeleteWindow;
}

sub filenotfound {
    $cw->Dialog (-title => 'File Not Found', -text => "Could not open @_",
		   -bitmap => 'error', -font => $fn) -> Show;
}

sub selectfile {
    my $d = $cw -> SimpleFileSelect;
    $ifname = $d -> Show;
    return filenotfound ($ifname) if (length $ifname and (not -f $ifname));
    openfile ();