make it useful

- print problems with GREP_COLOR
- have enough exceptions to get usable errors

1 files changed, 85 insertions, 15 deletions

diff --git a/perl-install/share/po/validate.pl b/perl-install/share/po/validate.pl
index e2383ba9e..b724abc7b 100755
--- a/perl-install/share/po/validate.pl
+++ b/perl-install/share/po/validate.pl
@@ -15,6 +15,10 @@
 
 # Tool to avoid common grammar errors in po files.
 
+use MDK::Common;
+
+my $col = $ENV{GREP_COLOR} || "01";
+sub colorize { "[1;$col;40m@_" }
 
 sub get_file($)
 {
@@ -36,35 +40,98 @@ sub get_file($)
 }
 
 
-my $line_number = 0;
+sub check
+{
+    my ($category, $condition, $msg, @exceptions) = @_;
+    my $line = $_;
+    my $rest = '';
+    #- kinda hard to make multiple match and still can highlight the right one..
+    my $adv = sub { $rest .= substr $line, 0, 1; $line =~ s/^.// };
+    while (length($line) > 1) {
+	$line =~ /$condition/ or return;
+	my ($rest_, $before, $match, $after) = ($rest, $`, $&, $');
+	$adv->() foreach 1 .. length($before);
+	$_->($before, $match, $after) and goto next_char foreach @exceptions;
+	printf "$category: %-30s ", $msg; print $rest_, $before, colorize($match), $after;
+      next_char:
+	$adv->() foreach 1 .. length($match);
+    }
+}
+
+
+my @names = qw(XFree MHz GHz KBabel XFdrake IPv4 MTools iBook DrakX MacOS MacOSX G3 G4 DVD
+               Drakbackup Inc Gnome Mandrake IceWM MySQL PostgreSQL Enlightenment Window WindowMaker Fvwm
+               SunOS ReiserFS iMac
+               CD OF LPRng ext2FS PowerBook OSs CUPS NIS KDE GNOME BootX TVout
+               WebDAV IP SMB Boston MA MtoolsFM PCI USB ISA PnP XawTV PSC LaserJet Sony LPT\d
+               Frank Thomas Sergey XSane M ClusterNFS 3Com drakTermServ RAMdisk LOCAL);
 
-# --- Problems potentially common to multiple languages
+sub match {
+    my ($e) = @_; sub {
+	my ($before, $match, $after) = @_;
+	$match =~ /^$e/
+    }
+}
+sub match_after {
+    my ($e) = @_; sub {
+	my ($before, $match, $after) = @_;
+	"$match$after" =~ /^$e/
+    }
+}
+sub match_full {
+    my ($e) = @_; sub {
+	my ($before, $match, $after) = @_;
+	"$match$after" =~ /^$e/
+    }
+}
 
 sub mixed_case($)
 {
-    (/[\^ ][A-Z][A-Z][a-z]/ && !/XFree/ || /[\^ ][a-z][A-Z]/) and print("**.po possible-mixed-case         $_");
+    check('**', '\b\w[A-Z]\w*[a-z]\b', 'mixed-case',
+	  sub { my ($b, $m, $a) = @_; $b =~ /\\$/ && $m =~ /^t/ },
+	  sub { my ($b, $m, $a) = @_; $b =~ /\\$/ && $m =~ /^fI/ },
+	  match('_[A-Z][a-z]+\b'),
+	  map { match_after($_.'\b') } @names);
+    check('**', '\b\w[a-z]\w*[A-Z]\b', 'mixed-case',
+	  map { match_after($_.'\b') } @names);
 }
 
 sub uppercase_after_comma($)
 {
-    /, [A-Z]/ and print("**.po uppercase-after-comma       $_");
+    check('**', ', [A-Z]', 'uppercase-after-comma',
+	  map { match_after(", $_".'\b') } @names);
 }
 
 sub lowercase_after_dot($)
 {
-    /\. [a-z]/ and print("**.po lowercase-after-dot         $_");
+    check('**', '\. [a-z]', 'lowercase-after-dot',
+	  sub { my ($b, $m, $a) = @_; any { $b =~ /$_$/ } qw(id ex) },
+	  sub { my ($b, $m, $a) = @_; any { $b =~ /\Q$_\E$/ } qw (S.A N.B) },
+	  map { match_after('\. '.$_) } @names);
 }
 
-sub no_space_after_simple_ponct($)
+sub no_space_after_ponct($)
 {
-    /[a-zA-Z\.]+@[a-zA-Z]/ and return;
-    /[,\.][a-zA-Z]/ and print("**.po no-space-after-simple-ponct $_");
+    check('**', '[,\.:;]\w', 'no-space-after-ponct',
+	  sub { my ($b, $m, $a) = @_; any { my ($beg, $end) = /^(.)(..)/; $b =~ /$beg$/ && $m eq $end } qw(S.A N.B M.N L.P) },
+	  sub { my ($b, $m, $a) = @_; any { my ($beg, $end) = /^(...)(..)/; $b =~ /\Q$beg\E$/ && $m eq $end } qw(M.N.F L.P.I) },
+	  sub { my ($b, $m, $a) = @_; any { "$m$a" =~ /\S*\.$_\b/ }
+		  qw(com fr h d htm o org php php3 cf conf img deny pfm afm cfg tftpd allow bin uk lzrom nbi net old dir scale tbxi) },
+	  match_after('\.ex\.'),    #- p.ex.
+	  match(':[a-fA-F]'),       #- ipv6
+	  map { match_after(".$_") } qw(cmode mclk vmode LTR rpmnew backupignore root_squash all_squash), 0..9 );
+}
+
+sub doubly_ponct($)
+{
+    check('**', '([\.,:;])\1', 'doubly-ponct',
+	  match_after(quotemeta('...')));
 }
 
 sub space_before_simple_ponct($)
 {
-    / \.\./ and return;
-    / [,\.]/ and print("**.po space-before-simple-ponct   $_");
+    check('**', '\s[,\.]', 'space-before-simple-ponct',
+	  map { match_after('\s\.'.$_) } qw(rpmnew backupignore afm pfm));
 }
 
 
@@ -73,14 +140,17 @@ sub space_before_simple_ponct($)
 
 foreach (get_file("fr.po"))
 {
+    #- line oriented verifications
     /\s*#/ and next;
-    /ez [^ ]+ez/ and print("fr.po infinitive-form-with-ez     $_");
-    /è[ \.,;:]/ and  print("fr.po grave-accent-at-end-of-word $_");
-    (/[éêè][éêè]/ && !/créé/) and print("fr.po strange-accents-succession  $_");
-    /G[nN][uU]\/[lL]inux/ and print("fr.po GNU-slash-Linux-found       $_");
+
+    check('fr', 'ez\s+\S+ez', 'infinitive-form-with-ez');
+    check('fr', 'è[ \.,;:]', 'grave-accent-at-end-of-word');
+    check('fr', '\b\w*[éêè][éêè]\w*\b', 'strange-accents-succession',
+	  map { match($_) } qw(créé réécrire));
     mixed_case($_);
     uppercase_after_comma($_);
     lowercase_after_dot($_);
-    no_space_after_simple_ponct($_);
+    no_space_after_ponct($_);
+    doubly_ponct($_);
     space_before_simple_ponct($_);
 }