summaryrefslogtreecommitdiffstats
path: root/scripts/spellcheck.pl
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/spellcheck.pl')
-rw-r--r--scripts/spellcheck.pl301
1 files changed, 301 insertions, 0 deletions
diff --git a/scripts/spellcheck.pl b/scripts/spellcheck.pl
new file mode 100644
index 0000000..3fc6861
--- /dev/null
+++ b/scripts/spellcheck.pl
@@ -0,0 +1,301 @@
+# Copyright © 2008 Jakub Jankowski <shasta@toxcorp.com>
+# Copyright © 2012-2020 Jakub Wilk <jwilk@jwilk.net>
+# Copyright © 2012 Gabriel Pettier <gabriel.pettier@gmail.com>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 dated June, 1991.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+
+use strict;
+use warnings;
+
+use vars qw($VERSION %IRSSI);
+use Irssi 20070804;
+use Irssi::TextUI;
+use Encode;
+use Text::Aspell;
+
+$VERSION = '0.9.1';
+%IRSSI = (
+ authors => 'Jakub Wilk, Jakub Jankowski, Gabriel Pettier, Nei',
+ name => 'spellcheck',
+ description => 'checks for spelling errors using Aspell',
+ license => 'GPLv2',
+ url => 'http://jwilk.net/software/irssi-spellcheck',
+);
+
+my %speller;
+
+sub spellcheck_setup
+{
+ my ($lang) = @_;
+ my $speller = $speller{$lang};
+ return $speller if defined $speller;
+ $speller = Text::Aspell->new or return;
+ $speller->set_option('lang', $lang) or return;
+ $speller->set_option('sug-mode', 'fast') or return;
+ $speller{$lang} = $speller;
+ return $speller;
+}
+
+# add_rest means "add (whatever you chopped from the word before
+# spell-checking it) to the suggestions returned"
+sub spellcheck_check_word
+{
+ my ($langs, $word, $add_rest) = @_;
+ my $win = Irssi::active_win();
+ my $prefix = '';
+ my $suffix = '';
+
+ my @langs = split(/[+]/, $langs);
+ for my $lang (@langs) {
+ my $speller = spellcheck_setup($lang);
+ if (not defined $speller) {
+ $win->print('%R' . "Error while setting up spell-checker for $lang" . '%N', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ }
+
+ return if $word =~ m{^/}; # looks like a path
+ $word =~ s/^([[:punct:]]*)//; # strip leading punctuation characters
+ $prefix = $1 if $add_rest;
+ $word =~ s/([[:punct:]]*)$//; # ...and trailing ones, too
+ $suffix = $1 if $add_rest;
+ return if $word =~ m{^\w+://}; # looks like a URL
+ return if $word =~ m{^[^@]+@[^@]+$}; # looks like an e-mail
+ return if $word =~ m{^[[:digit:][:punct:]]+$}; # looks like a number
+
+ my @result;
+ for my $lang (@langs) {
+ my $ok = $speller{$lang}->check($word);
+ if (not defined $ok) {
+ $win->print('%R' . "Error while spell-checking for $lang" . '%N', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+ if ($ok) {
+ return;
+ } else {
+ push @result, map { "$prefix$_$suffix" } $speller{$lang}->suggest($word);
+ }
+ }
+ return \@result;
+}
+
+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) {
+ my ($t, $c, $l) = $langstr =~ m{^(?:([^/]+)/)?([^/]+)/([^/]+)/*$};
+ $t //= $network;
+ if (lc($c) eq $target and lc($t) eq $network) {
+ return $l;
+ }
+ }
+
+ # no match, use defaults
+ return Irssi::settings_get_str('spellcheck_default_language');
+}
+
+sub spellcheck_find_language
+{
+ my ($win) = @_;
+ return _spellcheck_find_language(
+ $win->{active_server}->{tag},
+ $win->{active}->{name}
+ );
+}
+
+sub spellcheck_key_pressed
+{
+ my ($key) = @_;
+ my $win = Irssi::active_win();
+
+ my $correction_window;
+ my $window_height;
+
+ my $window_name = Irssi::settings_get_str('spellcheck_window_name');
+ if ($window_name ne '') {
+ $correction_window = Irssi::window_find_name($window_name);
+ $window_height = Irssi::settings_get_str('spellcheck_window_height');
+ }
+
+ return unless Irssi::settings_get_bool('spellcheck_enabled');
+
+ # hide correction window when message is sent
+ if (chr($key) =~ /\A[\r\n]\z/ && $correction_window) {
+ $correction_window->command("^window hide $window_name");
+ if (Irssi->can('gui_input_clear_extents')) {
+ Irssi::gui_input_clear_extents(0, 9999);
+ }
+ }
+
+ # get current inputline
+ my $inputline = Irssi::parse_special('$L');
+ my $utf8 = lc Irssi::settings_get_str('term_charset') eq 'utf-8';
+ if ($utf8) {
+ Encode::_utf8_on($inputline);
+ }
+
+ # ensure that newly added characters are not colored
+ # when correcting a colored word
+ # FIXME: this works at EOL, but not elsewhere
+ if (Irssi->can('gui_input_set_extent')) {
+ Irssi::gui_input_set_extent(length $inputline, '%n');
+ }
+
+ # don't bother unless pressed key is space
+ # or a terminal punctuation mark
+ return unless grep { chr $key eq $_ } (' ', qw(. ? !));
+
+ $inputline = substr $inputline, 0, Irssi::gui_input_get_pos();
+
+ # check if inputline starts with any of cmdchars
+ # we shouldn't spell-check commands
+ # (except /SAY and /ME)
+ my $cmdchars = Irssi::settings_get_str('cmdchars');
+ my $re = qr{^(?:
+ [\Q$cmdchars\E] (?i: say | me ) \s* \S |
+ [^\Q$cmdchars\E]
+ )}x;
+ return if ($inputline !~ $re);
+
+ # get last bit from the inputline
+ my ($word) = $inputline =~ /\s*(\S+)\s*$/;
+ defined $word or return;
+
+ # remove color from the last word
+ # (we will add it back later if needed)
+ my $start = $-[1];
+ if (Irssi->can('gui_input_clear_extents')) {
+ Irssi::gui_input_clear_extents($start, length $word);
+ }
+
+ my $lang = spellcheck_find_language($win);
+
+ return if $lang eq 'und';
+
+ my $suggestions = spellcheck_check_word($lang, $word, 0);
+
+ return unless defined $suggestions;
+
+ # strip leading and trailing punctuation
+ $word =~ s/^([[:punct:]]+)// and $start += length $1;
+ $word =~ s/[[:punct:]]+$//;
+
+ # add color to the misspelled word
+ my $color = Irssi::settings_get_str('spellcheck_word_input_color');
+ if ($color && Irssi->can('gui_input_set_extents')) {
+ Irssi::gui_input_set_extents($start, length $word, $color, '%n');
+ }
+
+ return unless Irssi::settings_get_bool('spellcheck_print_suggestions');
+
+ # show corrections window if hidden
+ if ($correction_window) {
+ $win->command("^window show $window_name");
+ $correction_window->command('^window stick off');
+ $win->set_active;
+ $correction_window->command("window size $window_height");
+ } else {
+ $correction_window = $win;
+ }
+
+ # we found a mistake, print suggestions
+
+ $word =~ s/%/%%/g;
+ $color = Irssi::settings_get_str('spellcheck_word_color');
+ if (scalar @$suggestions > 0) {
+ if ($utf8) {
+ Encode::_utf8_on($_) for @$suggestions;
+ }
+ $correction_window->print("Suggestions for $color$word%N - " . join(', ', @$suggestions));
+ } else {
+ $correction_window->print("No suggestions for $color$word%N");
+ }
+
+ return;
+}
+
+sub spellcheck_complete_word
+{
+ my ($complist, $win, $word, $lstart, $wantspace) = @_;
+
+ return unless Irssi::settings_get_bool('spellcheck_enabled');
+
+ my $lang = spellcheck_find_language($win);
+
+ return if $lang eq 'und';
+
+ # add suggestions to the completion list
+ my $suggestions = spellcheck_check_word($lang, $word, 1);
+ push(@$complist, @$suggestions) if defined $suggestions;
+
+ return;
+}
+
+sub spellcheck_add_word
+{
+ my ($cmd_line, $server, $win_item) = @_;
+ my $win = Irssi::active_win();
+ my @args = split(' ', $cmd_line);
+
+ if (@args <= 0) {
+ $win->print('SPELLCHECK_ADD <word>... add word(s) to personal dictionary');
+ return;
+ }
+
+ my $lang = spellcheck_find_language($win);
+
+ my $speller = spellcheck_setup($lang);
+ if (not defined $speller) {
+ $win->print('%R' . "Error while setting up spell-checker for $lang" . '%N', MSGLEVEL_CLIENTERROR);
+ return;
+ }
+
+ $win->print("Adding to $lang dictionary: @args");
+ for my $word (@args) {
+ $speller{$lang}->add_to_personal($word);
+ }
+ my $ok = $speller{$lang}->save_all_word_lists();
+ if (not $ok) {
+ $win->print('%R' . "Error while saving $lang dictionary" . '%N', MSGLEVEL_CLIENTERROR);
+ }
+
+ return;
+}
+
+Irssi::command_bind('spellcheck_add', 'spellcheck_add_word');
+
+Irssi::settings_add_bool('spellcheck', 'spellcheck_enabled', 1);
+Irssi::settings_add_bool('spellcheck', 'spellcheck_print_suggestions', 1);
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_default_language', 'en_US');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_languages', '');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_word_color', '%R');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_word_input_color', '%U');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_window_name', '');
+Irssi::settings_add_str( 'spellcheck', 'spellcheck_window_height', 10);
+
+Irssi::signal_add_last('key word_completion', sub{spellcheck_key_pressed(ord '.')});
+Irssi::signal_add_last('key word_completion_backward', sub{spellcheck_key_pressed(ord '.')});
+Irssi::signal_add_last('gui key pressed', 'spellcheck_key_pressed');
+Irssi::signal_add_last('complete word', 'spellcheck_complete_word');
+
+1;
+
+# vim:ts=4 sts=4 sw=4 et