#!/usr/bin/perl -w

# ** This script is a (10+10)-minutes-hack, so it's EXPERIMENTAL. **
#
# Requires:
#  - Irssi 0.8.12 or newer (http://irssi.org/) with gui_input_color support.
#  - GNU Aspell with appropriate dictionaries (http://aspell.net/).
#  - Perl module Text::Aspell (available from CPAN).
#
#
# Description:
#  Works as you type, marking words when Aspell thinks
#  a word was misspelled.
#  It also adds suggestions to the list of tabcompletions,
#  so once you know last word is wrong, you can go back 
#  and tabcomplete through what Aspell suggests.
#
#
# Settings:
#
#  spellcheck_languages  -- a list of space and/or comma
#    separated languages to use on certain networks/channels.
#    Example: 
#    /set spellcheck_languages netA/#chan1/en_US, #chan2/fi_FI, netB/!chan3/pl_PL
#    will use en_US for #chan1 on network netA, fi_FI for #chan2
#    on every network, and pl_PL for !chan3 on network netB.
#    By default this setting is empty.
#
#  spellcheck_default_language  -- language to use in empty
#    windows, or when nothing from spellcheck_languages matches.
#    Defaults to 'en_US'.
#
#  spellcheck_enabled [ON/OFF]  -- self explaining. Sometimes
#    (like when pasting foreign-language text) you don't want
#    the script to spit out lots of suggestions, and turning it
#    off for a while is the easiest way. By default it's ON.
#
#
# BUGS:
#  - won't catch all mistakes
#  - picking actual words from what you type is very kludgy,
#    you may occasionally see some leftovers like digits or punctuation
#  - when you press space and realize that the word is wrong,
#    you can't tabcomplete to the suggestions right away - you need
#    to use backspace and then tabcomplete. With dot you get an extra
#    space after tabcompletion.
#  - all words will be marked and no suggestions given if 
#    dictionary is missing (ie. wrong spellcheck_default_language)
#  - probably more, please report to $IRSSI{'contact'}
#
#
# $Id: spellcheck.pl 5 2008-05-28 22:31:06Z shasta $
#

use strict;
use vars qw($VERSION %IRSSI);
use Irssi 20070804;
use Irssi::TextUI;
use Text::Aspell;
use utf8;

$VERSION = '0.4';
%IRSSI = (
    authors     => 'Jakub Jankowski, Jonas Hurrelmannn',
    contact     => 'j@outpo.st',
    name        => 'Spellcheck',
    description => 'Checks for spelling errors using Aspell.',
    license     => 'GPLv2',
    url         => 'http://outpo.st/irssi/',
);

my %speller;
my %wordcache;

sub spellcheck_setup
{
    return if (exists $speller{$_[0]} && defined $speller{$_[0]});
    $speller{$_[0]} = Text::Aspell->new or return undef;
    $speller{$_[0]}->set_option('lang', $_[0]) or return undef;
    $speller{$_[0]}->set_option('sug-mode', 'fast') or return undef;
    return 1;
}

# very stupid url checker.
sub is_url
{
    my ($strUrl) = @_;
    return $strUrl =~ m!(http:|https:|ftp:)//([A-z\d]+)\:([A-z\d]+)\@([A-z\d\-\.]+\.)+[A-z]!i ||
           $strUrl =~ m!^(http:|https:|ftp:)//([A-z\d\-\.]+\.)+[A-z]!i ||
           $strUrl =~ m!^(http:|https:|ftp:)//(\d){1,3}\.(\d){1,3}\.(\d){1,3}\.(\d){1,3}!i ? 1 : 0;
}

# check if the word is a nick in the active channel (adapted from nicklist.pl)
sub is_nick
{
    my ($word) = @_;
    my $channel = Irssi::active_win->{active};
    if ($channel
        && (ref($channel) eq 'Irssi::Irc::Channel' || ref($channel) eq 'Irssi::Silc::Channel')
        && ($channel->{'type'} eq 'CHANNEL' || ($channel->{chat_type} eq 'SILC'))
        && $channel->{'names_got'} ) {
        my ($stripped_word) = $word =~ /^[\.,:]*(.*?)[\.,:]*$/;
        foreach my $nick ($channel->nicks()) {
            my ($stripped_nick) = $nick->{"nick"} =~ /^[\.,:]*(.*?)[\.,:]*$/;
            if ($stripped_word eq $stripped_nick) {
                return 1;
            }
        }
    }
    return 0;
}


# add_rest means "add (whatever you chopped from the word before
# spellchecking it) to the suggestions returned"
sub spellcheck_get_suggestions
{
    my ($word, $add_rest) = @_;
    my $win = Irssi::active_win();
    my @suggestions = ();

    # return if we already cached to word.
    return @{$wordcache{$word}} if (exists $wordcache{$word});

    # add word to hash.
    @{$wordcache{$word}} = @suggestions;

    # check if the word is an url or a nick.
    return @suggestions if (is_nick($word));
    return @suggestions if (is_url($word));

    # find appropriate language for the current window item
    my $lang = spellcheck_find_language($win->{active_server}->{tag}, $win->{active}->{name});

    # setup Text::Aspell for that lang if needed
    if (!exists $speller{$lang} || !defined $speller{$lang})
    {
        if (!spellcheck_setup($lang))
        {
            $win->print("Error while setting up spellchecker for $lang");
            return @suggestions;
        }
    }

    # do the spellchecking
    my ($stripped, $rest) = $word =~ /([^[:punct:][:digit:]]{2,})(.*)/; # HAX
    if (defined $stripped && !$speller{$lang}->check($stripped))
    {
        push(@suggestions, $add_rest ? $_ . $rest : $_) for ($speller{$lang}->suggest($stripped));
    }

    # set list of suggestions.
    @{$wordcache{$word}} = @suggestions;
    return @suggestions;
}

sub spellcheck_find_language
{
    my ($network, $target) = @_;
    return Irssi::settings_get_str('spellcheck_default_language') unless (defined $network && defined $target);

    # support !channels correctly
    $target = '!' . substr($target, 6) if ($target =~ /^\!/);

    # lowercase net/chan
    $network = lc($network);
    $target  = lc($target);

    # possible settings: network/channel/lang  or  channel/lang
    my @languages = split(/[ ,]/, Irssi::settings_get_str('spellcheck_languages'));
    for my $langstr (@languages)
    {
        # strip trailing slashes
        $langstr =~ s=/+$==;
        # Irssi::print("Debug: checking network $network target $target against langstr $langstr");
        my ($s1, $s2, $s3) = split(/\//, $langstr, 3);
        my ($t, $c, $l);
        if (defined $s3 && $s3 ne '')
        {
            # network/channel/lang
            $t = lc($s1); $c = lc($s2); $l = $s3;
        }
        else
        {
            # channel/lang
            $c = lc($s1); $l = $s2;
        }

        if ($c eq $target && (!defined $t || $t eq $network))
        {
            # Irssi::print("Debug: language found: $l");
            return $l;
        }
    }

    # Irssi::print("Debug: language not found, using default");
    # no match, use defaults
    return Irssi::settings_get_str('spellcheck_default_language');
}

sub spellcheck_is_word_correct
{
    my ($word) = @_;
    return (scalar spellcheck_get_suggestions($word, 0) == 0);
}

sub spellcheck_key_pressed
{
    my ($key) = @_;
    my $win = Irssi::active_win();

    return unless Irssi::settings_get_bool('spellcheck_enabled');

    # get current inputline
    my $inputline = Irssi::parse_special('$L');

    # check if inputline starts with any of cmdchars
    # we shouldn't spellcheck commands
    my $cmdchars = Irssi::settings_get_str('cmdchars');
    my $re = qr/^[$cmdchars]/;
    return if ($inputline =~ $re);

    my $text =  $inputline;
    utf8::decode($text);
    my $pos = 0;
    my $word;
    my $color;
    my $end;
    while(($end = index($text," ",$pos)) >= 0)
    {
        $word = substr($text, $pos, $end-$pos);
        if (length($word) > 0) 
        {
            $color = spellcheck_is_word_correct($word) ? 7 : 4;
            Irssi::gui_input_color($pos, length($word), $color);
        }
        $pos = $end + 1;
    }
    $end = length($text);
    $word = substr($text, $pos, $end-$pos);
    if (length($word) > 0) 
    {
        $color = spellcheck_is_word_correct($word, 0) ? 7 : 4;
        Irssi::gui_input_color($pos, length($word), $color);
    }
}


sub spellcheck_complete_word
{
    my ($complist, $win, $word, $lstart, $wantspace) = @_;

    return unless Irssi::settings_get_bool('spellcheck_enabled');

    # add suggestions to the completion list
    push(@$complist, spellcheck_get_suggestions($word, 1));
}

sub spellcheck_clear_cache
{
    # for now clear the cache on every line.
    %wordcache = ();
}


Irssi::settings_add_bool('spellcheck', 'spellcheck_enabled', 1);
Irssi::settings_add_str('spellcheck', 'spellcheck_default_language', 'en_US');
Irssi::settings_add_str('spellcheck', 'spellcheck_languages', '');

Irssi::signal_add_last('gui key pressed', 'spellcheck_key_pressed');
Irssi::signal_add_last('complete word', 'spellcheck_complete_word');

Irssi::signal_add_last('send command', 'spellcheck_clear_cache');