#!/usr/bin/perl -w

use strict;
use locale;
use Getopt::Long;
use Config::General;
use File::Copy;
use File::Spec::Functions;
use IO::File;
use Term::ReadLine;
use Term::ANSIColor;
use Term::Size;
use Data::Dumper;
use ACheck::Common;
use ACheck::Parser;
use ACheck::FileType;


# Constants setting
#
use constant VERSION	=> "0.4";			# script version number
use constant CONFFILE	=> ".acheck";			# Config file name


# Global variables
#
my $Rules;						# rules structure
my @Rules_stack	  = (-1);				# rules stack
my @Rules_success = ( 0);				# number of success test per stack level
my @Rules_loop	  = ( 0);				# loop counter

my @Lines_orig;						# original file
my @Lines_current = ("");				# current line and added comments
my @Lines_fixed   = ("");				# fixed file and comments
my $Lines_whole;					# whole current line

eval "use Text::Aspell;";
my $Aspell = not $@;					# true if Aspell module found
my $Speller;
   $Speller = Text::Aspell->new if $Aspell;		# spell checker

my $Term = new Term::ReadLine ('');			# terminal

my $Comment_in   = 0;					# next line is comments
my $Comment_skip = 0;					# small comment found


# Configuration
# 
my %conf = (
	bak_ext			=> 'bak',
	comment			=> '>> ',
	check_spelling		=> 1,
	word_letters		=> '\w',
	review_mode		=> 0,
	display_menu		=> 1,
	debug			=> 0,
	rules_set		=> '',
	comment_color		=> 'cyan',
	error_color		=> 'bold on_red',
	fix_color		=> 'bold on_green',
	error_head_color	=> 'bold red',
	fix_head_color		=> 'bold green'
	);

if (-e catfile($ENV{HOME}, CONFFILE)) {
	my $config = new Config::General (
		-ConfigFile		=> catfile($ENV{HOME}, CONFFILE),
		-AllowMultiOptions	=> 'no',
		-LowerCaseNames		=> 'yes',
		-UseApacheInclude	=> 'no',
		-MergeDuplicateOptions	=> 'yes',
		-AutoTrue		=> 'yes',
		-DefaultConfig		=> \%conf
		);

	%conf = $config -> getall;
}

my $Bak_e		= $conf{'bak_ext'};		# backup files extension
my $Comment		= $conf{'comment'};		# comment string
my $Check_spelling	= $conf{'check_spelling'};	# use ispell if "yes"
my $Dictionary		= $conf{'dictionary'};		# aspell dictionary
my $Word_letters	= $conf{'word_letters'};	# letters regex
my $Review_mode		= $conf{'review_mode'}; 	# review mode if "yes"
my $Display_menu	= $conf{'display_menu'}; 	# display menu if "yes"
my $Rules_set		= $conf{'rules_set'}; 		# rules set

my $NC	      =     color(		   'clear' );	# color for normal text
my $CC	      = $NC.color($conf{   'comment_color'});	# comment text color
my $EC	      = $NC.color($conf{     'error_color'});	# highlighted error text color
my $FC	      = $NC.color($conf{       'fix_color'});	# highlighted fix text color
my $EL	      = $NC.color($conf{'error_head_color'});	# error letter color
my $FL	      = $NC.color($conf{  'fix_head_color'});	# fix letter color

set_debug($conf{'debug'});				# debug level


# get_offset
#
# split a string at the given offset
#
# input:
#   string
#   offset
# output:
#   part before the offset
#   part after
sub get_offset($$) {
	my $string = shift;
	my $offset = shift;

	my $len = length $string;

	if	($offset =~ /^s$/i) {
		$len = 0;
	} elsif	($offset =~ /^s\+(\d+)$/i) {
		$len = $1 < $len ?  $1 :  $len;
	} elsif	($offset =~ /^e$/i) {
	} elsif ($offset =~ /^e\-(\d+)$/i) {
		$len = $1 < $len ? -$1 : -$len;
	} else {
		suicide	__("`%s': unknow offset\n"), $offset;
	}
	return  substr($string, 0, $len),
		substr($string, $len   );
}


# line_next
#
# save fixed line and get next one
#
# output:
#   false if end of file
sub line_next() {
	debug 1;

	my $stop;
	my $first;
	my $offset;
	if ($Comment_skip) {
		$Lines_fixed[-1] .=     (defined $Lines_current[0]) ? shift @Lines_current : "";
		$Lines_fixed[-1] .=     (defined $Lines_orig   [0]) ? shift @Lines_orig    : "";	# skipped part
		unshift @Lines_current, (defined $Lines_orig   [0]) ? shift @Lines_orig    : "";	# rest of the line
		$Comment_skip--;
		return 1;
	}
	if ($Comment_in) {
		$stop	= (defined $Lines_orig[0]) ? shift @Lines_orig : suicide __("comment: no stop regex\n");
		$offset = (defined $Lines_orig[0]) ? shift @Lines_orig : "e";
		$Lines_fixed[-1] .=     (defined $Lines_current[0]) ? shift @Lines_current : "";
		unshift @Lines_current, (defined $Lines_orig   [0]) ? shift @Lines_orig    : "";
		$first = 1;
	}
	while ($Comment_in) {
		if ($Lines_current[0] =~ /$stop/) {
			my $a;
			my $b;
			$Lines_fixed  [-1] .= (defined $`) ? $` : "";
			$Lines_current[ 0]  = (defined $') ? $' : "";
			($a, $b) = get_offset($&, $offset);
			$Lines_fixed  [-1] .= $a;
			$Lines_current[ 0]  = $b.$Lines_current[0];
			$Comment_in--;
			return 1;
		} else {
			if ($first) {
				$Lines_fixed[-1] .= (defined $Lines_current[0]) ? shift @Lines_current : "";
				push @Lines_fixed, map { $_ = $Comment.$_ } @Lines_current	if $Review_mode;
				$first = 0;
			} else {
				$Lines_fixed[-1] .= (defined $Lines_current[0]) ? shift @Lines_current : "";
			}
			debug 0, $Lines_fixed[-1]."\n";
			@Lines_current = (shift @Lines_orig);
			push @Lines_fixed, "";
		}
	}

	$Lines_fixed[-1] .= (defined $Lines_current[0]) ? shift @Lines_current : "";
	push @Lines_fixed, map { $_ = $Comment.$_ } @Lines_current	if $Review_mode;
	push @Lines_fixed, "";

	$Lines_whole   = shift @Lines_orig  ;
	@Lines_current =      ($Lines_whole);
	debug 0, ($Lines_current[0] || "")."\n";

	return defined $Lines_whole;
}


# stack_add
#
# add one stack level
#
# output:
#   next stack
sub stack_add() {
	push @Rules_stack,  -1;				# add one stack level
	push @Rules_success, 0;				# add one success level

	return @Rules_stack;
}


# stack_remove
#
# remove one stack level
#
# output:
#   next stack
sub stack_remove() {
	pop @Rules_stack;				# remove one stack level
	pop @Rules_success;

	return @Rules_stack;
}


# rule_get
#
# get a rule
#
# input:
#   rule stack
# output:
#   rule reference
sub rule_get(@) {
	debug 5;

	my $rule = $Rules->[shift @_];

	   $rule = $rule->{'rules'}[shift @_] while @_;

	return $rule;
}


# rule_current
#
# get current rule
#
# output:
#   rule reference
sub rule_current() {
	debug 5;

	return rule_get(@Rules_stack);
}


# rule_first
#
# set first rule of present stack level
#
# output:
#   rule stack
sub rule_first() {
	debug 1;

	$Rules_stack[@Rules_stack-1] = 0;		# first rule

	return @Rules_stack;
}


# rule_next
#
# set next rule of present stack level
#
# output:
#   false if end of stack level
#   new rule stack otherwise
sub rule_next() {
	debug 1;

	$Rules_stack[@Rules_stack-1]++;			# next rule at this stack level
		
	debug 3, (rule_current ? (rule_current->{'regex'} || rule_current->{'name'} || "") : "END OF LEVEL")."\n";

	return (defined rule_current) ? @Rules_stack : undef;
}


# rule_last
#
# set last rule of present stack level
#
# output:
#   rule stack
sub rule_last() {
	debug 1;

	$Rules_stack[@Rules_stack-1] = @{ rule_get(@Rules_stack[0,@Rules_stack-2])->{'rules'} };	# first rule

	return @Rules_stack;
}


# rule_print
#
# print current rule for debugging
sub rule_print() {
	my @s=@Rules_stack;
	my @r;
	unless (rule_current) {
		debug 0, "END OF LEVEL\n";
		return;
	}
	while (@Rules_stack) {
		unshift @r, rule_current->{'name'} || rule_current->{'regex'} || rule_current->{'skip'} || rule_current->{'test'} || rule_current->{'type'} || "";
		stack_remove;
	}
	debug 0, join(":", @r)."\n";
	@Rules_stack=@s;
}


# next_to_check
#
# set next rule to check
#
# output:
#   false if end of ruleset
#   new rule stack otherwise
sub next_to_check() {
	debug 1;

	while (1) {
		return 0 unless @Rules_stack;			# false if we removed the first stack level at previous pass

		rule_next  unless defined rule_current->{'test'};
rule_print if get_debug == 9;
		until (rule_current) {
			return 0 unless stack_remove;			# back one level
rule_print if get_debug == 9;
		}
		while (defined (my $test = rule_current->{'test'})) {
			if	(rule_current->{'type'} =~ /^until$/) {	# until
				unless ($Lines_whole =~ /$test/) {
					stack_add;
				}
			} elsif (rule_current->{'type'} =~ /^while$/) {	# while
				if     ($Lines_whole =~ /$test/) {
					stack_add;
				}
			} elsif (rule_current->{'type'} =~ /^loop$/) {
				if (($test == 0) || ($Rules_loop[-1] < $test)) {
					$Rules_loop[-1]++;
					stack_add;
				}
			}
			rule_next;
rule_print if get_debug == 9;
		}
			
		if (not (defined rule_current)) {		# we reached the end of this stack level
			return 0 unless stack_remove;			# back one level
		} elsif (rule_current->{'rules'}) {		# there are sub-rules
			stack_add;					# add one stack level
			rule_next;
rule_print if get_debug == 9;
		} else {
			last;
		}
	}

	return @Rules_stack;
}


# menu
#
# print menu
#
# input:
#   available command letters
#   number of corrections		[ optionnal ]
sub menu($;$) {
	my $l_com = shift;
	my $l_max = shift || 0;

	my  %command = (
		''=> undef,
		' ' => undef);
	{
		my @l = qw(E H N X a l i I);
		my @m = split(/\n/, __("Edit current line\nAdd hint\nSkip the rest of the line\nExit and discard all changes\nAdd in dictionnary\nAdd lowercase in dictionnary\nIgnore\nIgnore all\n"));	# _r_Replace\n_Replace all

		$command{shift @l} = shift @m	while @l;
	}

	my $letters = "";
	foreach (sort keys %command) {
		next unless $l_com =~ /$_/;
		$letters .= $_;
		next unless defined $command{$_};
		print ($EL.$_.$CC." $command{$_}".$NC."\n")	if $Display_menu;
	}

	my $prompt  =  $letters;
	   $prompt  =~ s/\W//g;
	   $prompt .=  " 0"		if $l_max;
	   $prompt .=  "-".($l_max-1)	if $l_max && $l_max-1;

	my $l = "_";
	until ($l =~ /^[$letters]?$/) {
		$l = $Term -> readline("$prompt\: ");
		chomp $l;
		last if ($l =~ /^\d+$/) && (0 <= $l) && ($l < $l_max);
	}

	return $l;
}


# command_edit
#
# edit error
#
# input:
#   string before the match
#   match string
#   string after the match
#   hint array reference
# return:
#   correction
sub command_edit($$) {
	my $match  = shift;
	my $hint   = shift;

	my $fix    = $Term -> readline(__("Enter correction to replace the highlighted part:\n"), $match);

	if ($Review_mode) {
		push @Lines_current, ($Term -> readline(__("Enter explanation, use displayed hint if empty:\n"))) || @{ $hint };
	}

	return $fix;
}


# command_line
#
# edit the current line
#
# input:
#   hint array reference
# return:
#   true
sub command_line($) {
	my $hint = shift;

	$Lines_current[0] = $Term -> readline(__("Modify the line:\n"), $Lines_current[0]);

	if ($Review_mode) {
		push @Lines_current, $Term -> readline(__("Enter explanation, use displayed hint if empty:\n")) || @{ $hint };
	}

	return 1;
}


# command_hint
#
# add hints
#
# input:
#   hint array reference
# return:
#   true
sub command_hint($) {
	my $hint = shift;

	push @Lines_current, @{ $hint };

	return 1;
}


# command_next
#
# go for next line
#
# return:
#   true
sub command_next() {
	$Rules_success[0]++;

	return 1;
}


# command_exit
#
# print exit and discard message and wait for right answer
#
# return:
#   false unless exit
sub command_exit() {
	my $l;
	$l = $Term -> readline(__("Exit and discard all changes! type `yes' to confirm: "));
	chomp $l;
	exit if $l eq __("yes");
}


# command_nop
#
# nothing
#
# return:
#   true
sub command_nop() {
	return 1;
}


# make_fix
#
# prepare menu for fixing
#
# input:
#   string before error
#   matched error
#   string after error
#   array reference of fixes
#   array reference of hints
sub make_fix($$$$$) {
	my $before = shift;
	my $match  = shift;
	my $after  = shift;
	my $fix    = shift;
	my $hint   = shift;

	my $bef;						# beginning of the line to display
	my $aft;						# end of the line to display
	my $line_nb;						# number of displayable fixes
	my $line_len;						# number of colomns of the terminal
	my $head_len;						# line header length
	my  $bef_len;						# length before the fix
	my  $fix_len;						# max fix length
	my  $aft_len;						# length after the fix
	my $wish_len;						# length required
	my $half_len;						# egal displayable lenght around fix

	($line_len, $line_nb) = Term::Size::chars *STDOUT{IO};
	$line_len ||= 80;
	$line_nb  ||= 25;

	$line_nb -= ($Display_menu ? 3 : 0);
	$line_nb -=  4;
	$line_nb  = min(scalar @{ $fix }, max($line_nb, 10));

	$bef = $Lines_fixed[-1].$before;
	$aft = $after;

	$head_len = length($line_nb) + 1;
	 $bef_len = length($bef);
	 $fix_len = max_length($match, @{ $fix });
	 $aft_len = length($aft);
	$wish_len = $head_len + $bef_len + $fix_len + $aft_len;
	$half_len = ($line_len-$head_len-$fix_len)/2;

	if ($wish_len > $line_len) {
		if	($bef_len < $half_len) {
			$aft = substr($aft, 0, $line_len-$head_len-$bef_len-$fix_len	      );
		} elsif ($aft_len < $half_len) {
			$bef = substr($bef,  -($line_len-$head_len	   -$fix_len-$aft_len));
		} else {
			$bef = substr($bef,   -$half_len);
			$aft = substr($aft, 0, $half_len);
		}
	}
	$bef_len = length $bef;
	$aft_len = length $aft;

	my $done = 0;
	until ($done) {
		print $EL." "x($head_len-1).">$NC";			# error line
		print "$bef$EC$match$NC$aft\n";

		my $l = 0;						# fixes
		foreach (@{ $fix  }) {
			last unless $l < $line_nb+1;
			my $head = $FL." "x($head_len-length($l)-1).$l.">".$NC;
			print $head;
			if ($bef_len > $head_len+1) {
				print " "x($bef_len-$head_len).$head."$FC$_$NC$aft\n";
			} else {
				print " "x $bef_len		    ."$FC$_$NC$aft\n";
			}
			$l++
		}
		print " "x$head_len." $CC$_$NC\n" foreach @{ $hint };	# hints
		$hint->[0] = sprintf(__("%s: %s"), $match, $hint->[0]);
	
		my $m = menu(" ENX", $l);

		if	($m eq "") {
		} elsif ($m eq "") {
			$done = command_nop;
		} elsif ($m eq " ") {
			$match = command_edit($match, $hint);
			$Lines_current[0] = $before.$match.$after;
			$done = command_nop;
		} elsif ($m eq "E") {
			$done = command_line($hint);
		} elsif ($m eq "N") {
			$done = command_next;
		} elsif ($m eq "X") {
			$done = command_exit;
		} elsif ((0 <= $m) && ($m < $l)) {
			$Lines_current[0] = $before.$fix->[$m].$after;
			$done = command_hint($hint);
		}
	}
}


# make_autofix
#
# prepare menu for autofixing
#
# input:
#   string before error
#   matched error
#   string after error
#   array reference of fixes
#   array reference of hints
sub make_autofix($$$$$) {
	my $before = shift;
	my $match  = shift;
	my $after  = shift;
	my $fix    = shift;
	my $hint   = shift;

	$fix    = $fix->[0];				# use first fix

	print "$EL >$NC";				# error line
	print $Lines_fixed[-1];
	print "$before$EC$match$NC$after\n";

	print "$FL >$NC";				# fix
	print $Lines_fixed[-1];
	print "$before$FC$fix$NC$after\n";

	print "$CC$_$NC\n" foreach @{ $hint };		# hint
	$hint->[0] = sprintf(__("%s: %s"), $match, $hint->[0]);

	$Lines_current[0] = $before.$fix.$after;
	command_hint($hint);
}


# make_warning
#
# prepare menu for warning
#
# input:
#   string before error
#   matched error
#   string after error
#   array reference of fixes
#   array reference of hints
sub make_warning($$$$$) {
	my $before = shift;
	my $match  = shift;
	my $after  = shift;
	my $fix    = shift;
	my $hint   = shift;

	my $done = 0;
	until ($done) {
		print "$EL >$NC";				# error line
		print $Lines_fixed[-1];
		print "$before$EC$match$NC$after\n";
	
		print "$CC$_$NC\n" foreach @{ $hint };		# hint
		$hint->[0] = sprintf(__("%s: %s"), $match, $hint->[0]);
	
		my $m = menu(" EHNX");

		if	($m eq "") {
		} elsif ($m eq "") {
			$done = command_nop;
		} elsif ($m eq " ") {
			$match = command_edit($match, $hint);
			$Lines_current[0] = $before.$match.$after;
			$done = command_nop;
		} elsif ($m eq "E") {
			$done = command_line($hint);
		} elsif ($m eq "H") {
			$done = command_hint($hint);
		} elsif ($m eq "N") {
			$done = command_next;
		} elsif ($m eq "X") {
			$done = command_exit;
		}
	}
}


# make_error
#
# prepare menu for error
#
# input:
#   string before error
#   matched error
#   string after error
#   array reference of fixes
#   array reference of hints
sub make_error($$$$$) {
	my $before = shift;
	my $match  = shift;
	my $after  = shift;
	my $fix    = shift;
	my $hint   = shift;

	my $done = 0;
	until ($done) {
		print "$EL >$NC";				# error line
		print $Lines_fixed[-1];
		print "$before$EC$match$NC$after\n";
	
		print "$CC$_$NC\n" foreach @{ $hint };		# hint
		$hint->[0] = sprintf(__("%s: %s"), $match, $hint->[0]);
	
		my $m = menu(" EHNX");

		if	($m eq "") {
		} elsif ($m eq " ") {
			$match = command_edit($match, $hint);
			$Lines_current[0] = $before.$match.$after;
			$done = command_nop;
		} elsif ($m eq "") {
			$done = command_nop;
		} elsif ($m eq "E") {
			$done = command_line($hint);
		} elsif ($m eq "H") {
			$done = command_hint($hint);
		} elsif ($m eq "N") {
			$done = command_next;
		} elsif ($m eq "X") {
			$done = command_exit;
		}
	}
}


# parse
#
# main parsing sub
#
sub parse() {
	debug 1;

	my $done;
	until ($done) {
		next_to_check;

		my $rule = rule_current;

		my $type = $rule->{'type'};

		if ($type =~ /^comment$/i) {
			my $start = $rule->{'start'};
			my $skip  = $rule->{'skip' };

			if ($skip  && $Lines_current[0] =~ /$skip/ ) {
				$Lines_current[0]  = (defined $`) ? $` : "";
				unshift @Lines_orig, (defined $') ? $' : "";
				unshift @Lines_orig, (defined $&) ? $& : "";
				$Comment_skip++;
			}
			if ($start && $Lines_current[0] =~ /$start/) {
				my $a;
				my $b;
				$Lines_current[0]  = (defined $`) ? $` : "";
				unshift @Lines_orig, (defined $') ? $' : "";
				($a, $b) = get_offset($&, $rule->{'start_offset'} || "s");
				$Lines_current[0] .= $a;
				$Lines_orig   [0]  = $b.$Lines_orig[0];
				unshift @Lines_orig, ($rule->{'stop_offset'} || "e");
				unshift @Lines_orig, ($rule->{'stop'	   }	   );
				$Comment_in++;
			}
			next;
		} elsif ($type =~ /^nop$/) {
			$done = 1;
			debug 3, "nop\n";

			next;
		}
		my $regex = $rule->{'regex'};
		my @fix   = $rule->{'fix'  } ? @{ $rule->{'fix'  } } : ();
		my @hint  = $rule->{'hint' } ? @{ $rule->{'hint' } } : ();
		my @valid = $rule->{'valid'} ? @{ $rule->{'valid'} } : ();
	
		if ($Lines_current[0] =~ /$regex/) {
			my $before = (defined $`) ? $` : "";
			my $match  = (defined $&) ? $& : "";
			my $after  = (defined $') ? $' : "";
			@fix = map { eval "\"$_\"" } @fix;	# group substitution		##### FIXME security? FIXME #####
	
			my $ok;
			foreach (@valid) {
				$ok = 1;
				$ok &= ($before =~ $_->{'pre' }) if defined $_->{'pre' };
				$ok &= ($match  =~ $_->{'in'  }) if defined $_->{'in'  };
				$ok &= ($after  =~ $_->{'post'}) if defined $_->{'post'};
				last if $ok;
			}
			next	     if $ok;

			if	($type =~ /^fix$/    ) {
				make_fix    ($before, $match, $after, \@fix, \@hint);
			} elsif ($type =~ /^autofix$/) {
				make_autofix($before, $match, $after, \@fix, \@hint);
			} elsif ($type =~ /^warning$/) {
				make_warning($before, $match, $after, \@fix, \@hint);
			} elsif ($type =~ /^error$/  ) {
				make_error  ($before, $match, $after, \@fix, \@hint);
			} else {
				suicide	__("`%s': unknown operation\n"), $type;
			}
		} 
	}
}


# aspell_fix
#
# fix using aspell module
#
# input:
#   mispelled word
sub aspell_fix($) {
	my $word = shift;

	my @suggestions = ($Speller->suggest($word));
	my $hint = [(sprintf __("spelling for `%s'"), $word)];

	my $bef;						# beginning of the line to display
	my $aft;						# end of the line to display
	my $line_nb;						# number of displayable fixes
	my $line_len;						# number of colomns of the terminal
	my $head_len;						# line header length
	my  $bef_len;						# length before the fix
	my  $fix_len;						# max fix length
	my  $aft_len;						# length after the fix
	my $wish_len;						# length required
	my $half_len;						# egal displayable lenght around fix

	($line_len, $line_nb) = Term::Size::chars;
	$line_len ||= 80;
	$line_nb  ||= 25;

	$line_nb -= ($Display_menu ? 8 : 0);
	$line_nb -=  4;
	$line_nb  = min(scalar @suggestions, max($line_nb, 10));

	$bef = $Lines_fixed[-1].$Lines_current[0];
	$aft = $Lines_current[1];

	$head_len = length($line_nb) + 1;
	 $bef_len = length($bef);
	 $fix_len = max_length($word, @suggestions);
	 $aft_len = length($aft);
	$wish_len = $head_len + $bef_len + $fix_len + $aft_len;
	$half_len = ($line_len-$head_len-$fix_len)/2;

	if ($wish_len > $line_len) {
		if	($bef_len < $half_len) {
			$aft = substr($aft, 0, $line_len-$head_len-$bef_len-$fix_len	      );
		} elsif ($aft_len < $half_len) {
			$bef = substr($bef,  -($line_len-$head_len	   -$fix_len-$aft_len));
		} else {
			$bef = substr($bef,   -$half_len);
			$aft = substr($aft, 0, $half_len);
		}
	}
	$bef_len = length $bef;
	$aft_len = length $aft;

	print $EL." "x($head_len-1).">$NC";			# error line
	print "$bef$EC$word"." "x($fix_len-length($word))."$NC$aft\n";

	my $l = 0;						# fixes
	foreach (@suggestions) {
		last unless $l < $line_nb+1;
		my $head = $FL." "x($head_len-length($l)-1).$l.">".$NC;
		print $head;
		if ($bef_len > $head_len+1) {
			print " "x($bef_len-$head_len).$head."$FC$_"." "x($fix_len-length($_))."$NC\n";
		} else {
			print " "x $bef_len		    ."$FC$_"." "x($fix_len-length($_))."$NC\n";
		}
		$l++
	}

	my $done = 0;
	until ($done) {
		my $m = menu(" aliIrRENX", $l);

		if	($m eq "") {
		} elsif ($m eq "") {
			$Lines_current[0] .= $word;
			$done = command_nop;
		} elsif ($m eq " ") {					# edit word
			$word = command_edit($word, $hint);
			$Lines_current[1] = $word.$Lines_current[1];	# change must be checked
			$done = command_nop;
		} elsif ($m eq "a") {					# add
			$Speller->add_to_personal($word);
			$Speller->save_all_word_lists;
			$Lines_current[0] .= $word;
			$done = command_nop;
		} elsif ($m eq "l") {					# add lowercase
			$Speller->add_to_personal(lc $word);
			$Speller->save_all_word_lists;
			$Lines_current[0] .= $word;
			$done = command_nop;
		} elsif ($m eq "i") {					# ignore
			$Lines_current[0] .= $word;
			$done = command_nop;
		} elsif ($m eq "I") {					# ignore all
			$Speller->add_to_session($word);
			$Lines_current[0] .= $word;
			$done = command_nop;
#		} elsif ($m eq "r") {					# replace
#			$Lines_current[0] .= $word;
#			$done = command_nop;
#		} elsif ($m eq "R") {					# replace all
#			$Lines_current[0] .= $word;
#			$done = command_nop;
		} elsif ($m eq "E") {
			$Lines_current[0] .= $word.$Lines_current[1];		# prepare for edition
			$done = command_line($hint);
			$Lines_current[1]  = $Lines_current[0];			# all line must be re-checked
			$Lines_current[0]  = "";
		} elsif ($m eq "N") {
			$Lines_current[0] .= $word.$Lines_current[1];
			$Lines_current[1]  = "";
			$done = command_next;
		} elsif ($m eq "X") {
			$done = command_exit;
		} elsif ((0 <= $m) && ($m < $l)) {
			$Lines_current[0] .= $suggestions[$m];
			$hint = [(sprintf __("%s: spelling for `%s'"),$suggestions[$m] ,$word)];
			$done = command_hint($hint);
		}
	}
}


# spell
#
# main spell-checking sub
#
sub spell() {
	debug 1;

	my @stack = @Rules_stack;
	while (@stack) {
		my $rule = rule_get(@stack);
		if (defined $rule->{'test'}) {
			last   unless defined $rule->{'spell'};
			return if	      $rule->{'spell'} =~ /^no$/i;
			last;
		} else {
			pop @stack;
			next;
		}
	}

	unshift @Lines_current, "";
	while (1) {
		my $found  = $Lines_current[1] =~ /[$Word_letters]+/i;
		my $before = (defined $`) ? $` : "";
		my $match  = (defined $&) ? $& : "";
		my $after  = (defined $') ? $' : "";

		unless ($found) {
			$Lines_current[0] .= $Lines_current[1];
			$Lines_current[1]  = "";
			last;
		}
		$Lines_current[0] .= $before;
		$Lines_current[1]  = $after;

		$found = $Speller->check($match);
		if	($found) {
			$Lines_current[0] .= $match;
		} elsif (defined $found) {
			aspell_fix($match);
		} else {					##### FIXME skip on error FIXME #####
			$Lines_current[0] .= $match;
		}
	}
	my $l = shift @Lines_current;
	        shift @Lines_current;
	      unshift @Lines_current, $l;
}


# parse_file
#
# parse a loaded file
#
sub parse_file() {
	debug 1;

	while (line_next) {
		parse;
		spell	if $Check_spelling && $Aspell;
	}

	shift @Lines_fixed;			# remove first item which was line #0 and so is empty
	pop   @Lines_fixed;			# remove last item which was prepared for next line and so is empty
}


# load_file
#
# load a file
#
# input:
#   filename
sub load_file($) {
	debug 3;

	my $file = shift;

	debug 1;
	debug 2, "filename      $file\n";

	my $handle = *STDIN;
	unless ($file eq "-") {
		$handle = new IO::File($file, '<')	or suicide __("Cannot read `%s': %s\n"), $file, $!;
	}
	@Lines_orig = $handle -> getlines;

	chomp @Lines_orig;
	@Lines_orig					or suicide __("Empty file\n");
}


# write_file
#
# write a file
#
# input:
#   filename
sub write_file($) {
	debug 3;

	my $file = shift;

	debug 1;
	debug 2, "filename      $file\n";

	my $handle = *STDOUT;
	unless ($file eq "-") {
		(-e $file) && (move($file, "$file.$Bak_e") or suicide __("Cannot backup `%s': %s\n"), $file, $!);
		$handle = new IO::File($file, '>')	   or suicide __("Cannot write to `%s': %s\n");
	}
	$handle -> print(join("\n", @Lines_fixed)."\n");
}


# print_version
#
# Print version
# 
sub print_version () {
	debug 1;

	my $me = $0;					# get command name with path
	   $me =~ s/.*\/([^\/]*)$/$1/;			# keep script name

	debug 0, __("%s version %s\n"), $me, VERSION;

	exit;
}


# print_help
#
# Print help message
# 
sub print_help () {
	debug 1;

	my $me = $0;					# get command name with path
	   $me =~ s/.*\/([^\/]*)$/$1/;			# keep script name
	debug 0, __("Usage: %s [OPTIONS] [INPUT_FILE]\n\noptions:\n  -q, --quiet          quiet mode\n  -v                   verbose, add more for more verbosity\n      --verbose        set verbosity to n\n      --rules <set>    use rules set <set>\n      --type <type>    set filetype to <type>\n  -i, --input <file>   input filename\n  -o, --output <file>  output filename\n  -s, --spell          check spelling with aspell\n  -d, --dict <lang>    use <lang> dictionary\n  -n, --nospell        don't check spelling\n  -r, --review         add comments (for reviewers)\n  -t, --trans          don't add comments (for translators)\n      --dump           dump the rules and exit (for debugging)\n  -V, --version        print version and exit\n  -h, --help           print this message and exit\n\nIf input filename is '-' or not provided, data are read from STDIN\nIf output filename is not provided, input filename is used, '-' write to STDOUT\n\n%s version %s\n"), $me, $me, VERSION;
	exit;
}


# main
#
# Parse command line
#
{
	debug 1;

	my $dump;							# flag for --dump option
	my $filetype;
	my  $input_file;
	my $output_file;
	
	Getopt::Long::Configure qw(permute bundling);			# set standard gnu options (for potato perl)
	Getopt::Long::GetOptions (
		'verbose=i'	=> sub { set_debug $_[1] },		# verbose <value>
		'v+'		=> sub { inc_debug },			# incremental
		'quiet|q'	=> sub { set_debug 0 },			# quiet
		'version|V'	=> sub { print_version; exit 0 },	# version
		'help|h'	=> sub { print_help;    exit 0 },	# help
		'input|i=s'	=> \$input_file,			# input filename
		'output|o=s'	=> \$output_file,			# output filename
		'rules=s'	=> \$Rules_set,				# rules set
		'type=s'	=> \$filetype,				# file type
		'spell|s'	=> sub { $Check_spelling  = 1 },	# use aspell
		'nospell|n'	=> sub { $Check_spelling  = 0 },	# short no
		'dict|d=s'	=> \$Dictionary,			# dictionary
		'review|r'	=> sub { $Review_mode = 1 },		# review mode
		'trans|t'	=> sub { $Review_mode = 0 },		# translation mode
		'dump'		=> sub { $dump = 1 }			# dump and exit
	);

	 $input_file ||= shift @ARGV if @ARGV;
	 $input_file ||= "-";
	$output_file ||= $input_file;

	debug 5,
		 "Configuration dump:\n".
		 "bak_e          ". $Bak_e."\n".
		 "comment        ". $Comment."\n".
		 "rules set      ".($Rules_set  || "")."\n";
	debug 4, "debug          ". get_debug."\n";
	debug 5, "check spelling ".($Check_spelling ? "yes" : "no" )."\n".
		 "aspell         ".($Aspell	    ? ""    : "not")."found\n".
		 "dictionary     ".($Dictionary || "")."\n".
		 "word letters   ". $Word_letters."\n".
		 "review mode    ".($Review_mode    ? "yes" : "no")."\n".
		 $CC."comments color".$NC."\n".
		 $EC."error text".$NC."\n".
		 $FC."fix text".$NC."\n".
		 $EL."error head color".$NC."\n".
		 $FL."fix head color".$NC."\n".
		 "version        ". VERSION."\n";
	debug 4, "input file     ". $input_file."\n".
		 "output file    ". $output_file."\n";
	debug 5, "file type      ". $filetype."\n"	 if $filetype;
	debug 4, "arguments      ".join(" ", @ARGV)."\n" if @ARGV;

	if (not ($Aspell) && $Check_spelling) {
		$Check_spelling = 0;
		if ((-t) && (-t STDOUT)) {
			print $EC.__("Aspell Perl module not found, spelling check cancelled.")."$NC\n";
			print $CC.__("Press 'Enter' to continue")."$NC\n";
			menu(" ");
		} else {
			warning __("Aspell Perl module not found, spelling check cancelled.");
		}
	}
	if ($Aspell && $Dictionary) {
		suicide(__("Aspell: unable to use `%s'.\n"), $Dictionary) unless $Speller -> set_option('lang', $Dictionary);
	}

	load_file $input_file;

	$filetype ||= file_type($input_file, \@Lines_orig);		# get file type if not provided
	$Rules      = load_ruleset($Rules_set, $filetype);

	if ($dump) {
		print Dumper($Rules);
		exit 0;
	}

	parse_file;

	write_file $output_file;
}

