lib/checkshortcut.pl

   1 #!/usr/bin/perl -w
   2 require 5.008;
   3 use bytes;
   4 use strict;
   5
   6 my %menu = ();
   7 my $srcdir = $ENV{'srcdir'} || '';
   8 $srcdir .= '/' if $srcdir;
   9
  10 open I, "<$srcdir../src/mainfrm.cc" or die $!;
  11 while (<I>) {
  12     m!(\w+)->Append[A-Za-z]*\(.*\(/\*.*?\*/(\d+)! && push @{$menu{$1}}, $2;
  13 }
  14 close I;
  15
  16 #for (sort keys %menu) { print "$_:".join("|", @{$menu{$_}})."\n" }
  17
  18 my $exitcode = 0;
  19 for my $lang (@ARGV) {
  20     $lang =~ s/\.msg$//; # allow en or en.msg
  21     my $hdr = "Lang $lang:\n";
  22     # .msg files could be in srcdir or build directory when building outside
  23     # the source tree
  24     open L, "<$srcdir$lang.msg" or open L, "<$lang.msg" or die $!;
  25     my $buf;
  26     read L, $buf, 20;
  27     read L, $buf, 999999;
  28     close L;
  29     my @msg = split /\0/, $buf;
  30     for my $menu (sort keys %menu) {
  31         my %sc;
  32         my %let;
  33         my $bad = 0;
  34         for (@{$menu{$menu}}) {
  35             my $m = $msg[$_];
  36             my ($item) = (split(/\\t/, $m))[0];
  37             my ($acc) = ($item =~ /\&([\x00-\x7f]|[\xc2-\xdf].|[\xe0-\xef]..|[\xf0-\xf4]...)/);
  38             if (!defined $acc) {
  39                 print "Lang $lang : message $_ '$m' has no shortcut\n";
  40                 $bad = 1;
  41             } else {
  42                 $acc = lc $acc;
  43                 if (exists $sc{$acc}) {
  44                     if (defined $hdr) {
  45                         print $hdr;
  46                         $hdr = undef;
  47                     }
  48                     print "Menu $menu : '$msg[$sc{$acc}]' and '$m' both use shortcut '$acc'\n";
  49                     $bad = 1;
  50                 } else {
  51                     $sc{$acc} = $_;
  52                 }
  53             }
  54
  55             # Tally available letters
  56             while ($item =~ /([A-Za-z]|[\xc2-\xdf].|[\xe0-\xef]..|[\xf0-\xf4]...)/g) {
  57                 $acc = lc $1;
  58                 next if $acc eq '…';
  59                 ++$let{$acc};
  60             }
  61         }
  62         if ($bad) {
  63             print "Unused letters: ", grep {!exists $sc{$_}} (sort keys %let), "\n";
  64             print "Not-present ASCII letters: ", grep {!exists $let{$_}} ('a' .. 'z'), "\n";
  65             $exitcode = 1;
  66         }
  67     }
  68     print "\n" unless defined $hdr;
  69 }
  70 exit $exitcode;