view release on metacpan or  search on metacpan

tkispell  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use Tk;
use Tk::widgets qw(Label Dialog Balloon);
use English qw'-no_match_vars';
use File::Copy;

our $VERSION = eval q{use App::tkispell; $App::tkispell::VERSION};

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

my $lang = $ENV{LANG};
if( !defined $lang or $lang =~ /^C$/ ) {
    $lang = 'default';
}

my $hdict;
my $ispell_prog;

if( $OSNAME eq 'MSWin32' ) {
    # XXX: better use File::HomeDir
    $hdict = $ENV{HOMEPATH}."/.ispell_$lang"; # Personal dictionary.
    
    # look for aspell first, as it the successor of ispell
    $ispell_prog = `where aspell`;
    chomp $ispell_prog;
    
    # fallback: if no aspell is found, look for ispell
    if( !defined $ispell_prog or $ispell_prog eq '' ) {
        $ispell_prog = `where ispell`;
        chomp $ispell_prog;
    }
    
}else{
    $hdict = $ENV{HOME}."/.ispell_$lang"; # Personal dictionary.
    
    $ispell_prog = `which aspell`;
    chomp $ispell_prog;
    
    # fallback: if no aspell is found, look for ispell
    if( !defined $ispell_prog or $ispell_prog eq '' ) {
        $ispell_prog = `which ispell`;
        chomp $ispell_prog;
    }
}

if( !defined $ispell_prog or $ispell_prog eq '' ) {
    warn "Did not find aspell or ispell. The check will not work. Please install aspell or ispell first and make it available in your PATH.";
}


my ($cw, $b1, @misspelledlist, @replacementlist, @addlist, @guesslist, $midx);
my $ifname = '';
my $lastmatchindex = '1.0';
my $matchlength = 0;
my $nextmiss = 0;
my $scriptname = $PROGRAM_NAME;

sub mainwindow {
    $cw = Tk::MainWindow->new(-title => $scriptname);
    $b1 = $cw->Balloon();
    my @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{
            return unless defined $midx;
            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',

tkispell  view on Meta::CPAN

            -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: $OS_ERROR\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 {
    $ifname = $cw->getOpenFile();
    return filenotfound($ifname) if (length $ifname and (not -f $ifname));
    openfile();
}

sub openfile {
    open IN, $ifname or (filenotfound($ifname) && return);
    while( my $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();
    if ($#misspelledlist < 0) {
        complete_notify();
        return 0;
    }
    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) {
        complete_notify();
        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 complete_notify {
    return if ! $ifname;
    $cw->Subwidget('list')->delete (0, 'end');
    $cw->Subwidget('list')->insert('end', 'Spell check complete.');
    return 0;
}


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) {
        my $mlength = 0;
        $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;
    return if ! $ifname;
    @guesslist = qx|"$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;
    if ($wordguesses[0]) {
        $wordguesses[0] =~ s/.*\: //;
        $cw->Subwidget('list')->insert('end', $_) 
	    foreach (split /, /, $wordguesses[0]);
    }
}

sub get_misspellings {
    return if ! $ifname;
    $cw->Busy(-recurse => 1);
    @misspelledlist = qx|"$ispell_prog" -l \<$ifname|;
    if ($#misspelledlist >= 0) {
        chomp foreach (@misspelledlist);
    }
    $cw->Unbusy(-recurse => 0);
}

mainwindow();

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

$cw->MainLoop;