#!/usr/local/bin/perl
use Tk;
use Tk::widgets qw(Label Dialog SimpleFileSelect);

$VERSION=0.16;

#
# Options - edit these for your system.
#
my $fn = '*-helvetica-medium-r-*-*-12-*'; # Widget font
my $hdict = $ENV{HOME}.'/.ispell_english'; # Personal dictionary. 

#my $ispell_prog = '/usr/local/bin/ispell'; # Ispell program.
my $ispell_prog = `which ispell`;  
chomp $ispell_prog;
my ($cw, @misspelledlist, @replacementlist, @addlist, $midx, $matchlength);
my $ifname = '';
my $lastmatchindex = '1.0';
my $nextmiss = 0;

sub mainwindow {
    $cw = new MainWindow (-title => 'Spell Check');
    @opts = (-padx => 5, -pady => 5);
    my $fl = $cw->Label (-textvariable => \$ifname, -font => $fn,
		      -justify => 'left', -relief => 'groove');
    $fl->grid(-row=>1, -column=>1, -columnspan=>3, -sticky => 'ew', @opts);
    my $cl = $cw->Scrolled ('Text', -height => 3, -wrap => 'none', 
	   -font => $fn, -scrollbars => 'se');
    $cl->Subwidget($_)->configure(-width=>10) foreach('xscrollbar','yscrollbar'); 
    $cl->grid (-row => 3,-column => 1,-columnspan => 3,-sticky => 'ew',@opts);
    $cw->Advertise ('text' => $cl);
    my $lb = $cw -> Scrolled ('Listbox', -font => $fn, -scrollbars => 'osoe');
    $lb->grid(-row => 4,-column => 1,-columnspan => 2,-sticky => 'ew',@opts);
    $cw->Advertise('list' => $lb);
    my $f = $cw->Frame(-container => 0)->grid(-row => 4,-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);
    $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);
    $b = $cw->Button(-text => 'Replace', -command => 
      sub{&replace && &checknext}, -width => 15, -font => $fn);
    $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);
    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);
    $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);
    $b -> grid (-row => 5, -column => 1, -sticky => 'ew', -in => $f2, @opts);
    $b = $cw -> Button (-text => 'Select File...', 
         -command => sub {&selectfile},-width => 15, -font => $fn);
    $b -> grid (-row => 5, -column => 2, -sticky => 'ew', -in => $f2, @opts);
    $b = $cw -> Button (-text => 'Close', -command => sub{&save_and_exit},
			-width => 15, -font => $fn);
    $b -> grid (-row => 5, -column => 3, -sticky => 'ew', -in => $f2, @opts);
}

sub save_and_exit {
    my $d = $cw -> Dialog (-title => 'Save File',
       -text => "Save $ifname?\nOriginal file will be saved as $ifname.bak.", 
       -bitmap => 'question', -font => $fn, -buttons => [qw/Ok Cancel/], 
       -default_button => 'Ok');
    $d -> Subwidget ('B_Ok') -> configure (-font => $fn);
    $d -> Subwidget ('B_Cancel') -> configure (-font => $fn);
    if (($d->Show) =~ /Ok/) {
	$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;
    }
    $d = $cw -> Dialog (-title => 'Add Words',
		-text => 'Save new words to your personal dictionary?',
		-bitmap => 'question', -font => $fn,
		-buttons => [qw/Ok Cancel/], -default_button => 'Ok');
    $d -> Subwidget ('B_Ok') -> configure (-font => $fn);
    $d -> Subwidget ('B_Cancel') -> configure (-font => $fn);
    if (($d->Show) =~ /Ok/) {
	$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;
}

sub openfile {
    open IN, $ifname or (&filenotfound ($ifname) && return);
    while(defined ($l=<IN>)){$cw->Subwidget('text')->insert('end',$l)}
    close IN;
}

sub addtexttags {
    $cw->Subwidget('text') -> markSet('insert',$midx);
    $cw->Subwidget('text') -> tagAdd('sel',$midx,"$midx+$matchlength chars");
    $cw->Subwidget('text') -> see ($midx);
}

sub adjust_index {
    my ($idx,$match) = @_;
    my ($mr,$mc) = split /\./, $idx;
    $mc += length $match;
    return "$mr.$mc";
}

sub checkfirst {
    &get_misspellings;
    &guesses;
    my $term = $misspelledlist[0];
    $midx = $cw->Subwidget('text')->search 
	(-forwards, -count => \$matchlength, $term, $lastmatchindex);
    $lastmatchindex = &adjust_index ($midx, $term);
    &addtexttags;
    &show_guesses;
    &misspelled_replace;
}

sub checknext {
    $cw->Subwidget('text')->tagRemove ('sel', '1.0', 'end');
    return if ++$nextmiss >= $#misspelledlist;
    (&checknext && return) if grep /$misspelledlist[$nextmiss]/, @addlist;
    $midx = ($cw->Subwidget('text')->search (-forwards,-count=>\$matchlength,
        $misspelledlist[$nextmiss],$lastmatchindex,'end'));
    if ((defined $midx) && (length $midx)) {
	&addtexttags;
	$lastmatchindex=&adjust_index($midx,$misspelledlist[$nextmiss]);
	&show_guesses;
	&misspelled_replace;
    }
    return 1;
}

sub misspelled_replace {
    $cw -> Subwidget ('replaceentry') -> delete (0, 'end');
    $cw -> Subwidget ('replaceentry') -> insert (0, &gettextselection);
}

sub gettextselection {
 return $cw->Subwidget('text')->get ($midx,"$midx+$matchlength chars");
}

sub replace {
    $cw -> Subwidget('text')-> delete('insert',"insert + $matchlength chars");
    my $replacement = $cw->Subwidget('replaceentry') -> get;
    $cw->Subwidget('text')->insert('insert', $replacement);
    push @addlist, ($replacement);
    $lastmatchindex = &adjust_index 
	(($cw->Subwidget('text')->index('insert')),$replacement);
}

sub replaceall {
    $cw -> Busy;
    my $lastindex = '1.0';
    my $misspelled = &gettextselection;
    my $replacement = $cw -> Subwidget ('replaceentry') -> get;
    while (1) {
     $midx = ($cw->Subwidget('text')->search 
       (-forwards, -count => \$mlength, $misspelled,$lastindex,'end'));
     last unless length $midx;
     $cw->Subwidget('text')->delete($midx, "$midx + $mlength chars");
     $cw->Subwidget('text')->insert($midx, $replacement);
     $lastindex = &adjust_index ($midx,$replacement);
    }
    push @addlist, ($replacement);
    $cw -> Unbusy;
}

sub guesses {
    $cw -> Busy;
    @guesslist = `$ispell_prog -a <$ifname 2>&1`;
    shift @guesslist;  # remove the ispell id
    chomp foreach (@guesslist);
    $cw -> Unbusy;
}

sub show_guesses {
    $cw->Subwidget('list') -> delete (0, 'end');
    my $misspelling = &gettextselection;
    my @wordguesses = grep /\& $misspelling/, @guesslist;
    $wordguesses[0] =~ s/.*\: //;
    $cw -> Subwidget('list') -> insert ('end', $_) 
	foreach (split /, /, $wordguesses[0]);
}

sub get_misspellings {
    $cw -> Busy (-recurse => 1);
    @misspelledlist = `$ispell_prog -l <$ifname`;
    chomp foreach (@misspelledlist);
    $cw -> Unbusy (-recurse => 0);
}

&mainwindow;
(($ifname=$ARGV[0]) && &openfile) if(defined $ARGV[0] and length $ARGV[0]);
MainLoop;


