#!/usr/bin/perl -w

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

$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, @misspelledlist, @replacementlist, @addlist, $midx, $matchlength);
my $ifname = '';
my $lastmatchindex = '1.0';
my $nextmiss = 0;
my $scriptname = $O;

sub mainwindow {
    $cw = new MainWindow (-title => $O);
    @opts = (-padx => 5, -pady => 5);
    my $cl = $cw->Scrolled ('Text', -height => 3, -wrap => 'none', 
	   -font => $fn, -scrollbars => 'se');
    $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);
    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);
    $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 => 'Dismiss', -command => sub{save_and_exit ()},
			-width => 15, -font => $fn);
    $b -> grid (-row => 5, -column => 3, -sticky => 'ew', -in => $f2, @opts);
}

sub save_and_exit {
    $cw -> WmDeleteWindow if (defined ($ifname) && ! length ($ifname));
    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;
    }
    $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 ();
}

sub openfile {
    open IN, $ifname or (filenotfound ($ifname) && return);
    while(defined ($l=<IN>)){$cw->Subwidget('text')->insert('end',$l)}
    $cw -> configure (-title => "$ifname");
    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');
    if (++$nextmiss >= $#misspelledlist) {
	$cw->Subwidget('list') -> delete (0, 'end');
	$cw -> Subwidget('list') -> insert ('end', 'Spell check complete.');
	return 0;
    }
    (checknext () && return 1) 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);
    $cw->Subwidget('text') -> markSet('insert',$lastmatchindex);
}

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;

__DATA__;

=head1 NAME

tkispell - Perl/Tk user interface for ispell.

=head1 SYNPOSIS

tkispell [filename]

=head1 DESCRIPTION

Tkispell is a Perl/Tk user interface to ispell.  

With a file name as a command line argument, tkispell opens the file.
Clicking the, "Select File...," button opens a Dialog box where the
user can also select a file.

The, "Check," button begins the spell checking process.  The listing
at the top of the window shows unrecognized words, and the listing in
the middle of the window shows the alternatives provided by ispell.

Clicking the, "Dismiss," button exits the program, after asking 
if the program should save the spell checked file and the replacement
words in the user's personal dictionary.

The entry box at the lower right contains replacement text for
misspelled words.  It can either be a selection from the word guesses
or entered by the user.

The buttons on the right side of the window are the options for 
replacing possibly misspelled words.

=head2 Accept

Accept the word and continue to the next word to be checked.

=head2 Add

Add the unknown word to the personal dictionary.

=head2 Replace

Replace the misspelled word.

=head2 Replace All

Replace all instances of the mispelled word.


=head1 PERSONAL DICTIONARY

Tkispell uses ispell's personal dictionary naming conventions:
$HOME/.ispell_<language> or $HOME/.ispell_default if the $LANG
environment variable is, "C," or is not set.

=head1 REVISION INFO

Id: tkispell,v 1.4 2004/02/27 01:37:16 kiesling Exp $

=head1 COPYRIGHT

Copyright  2001-2004 Robert Kiesling, rkies@cpan.org.

Licensed under the same terms as Perl. Refer to the file, "Artistic."

=head1 SEE ALSO

perl(1), ispell(1), Tk(1)

=cut




