source: git/lib/checkshortcut.pl @ 6316bfa

RELEASE/1.2debug-cidebug-ci-sanitisersstereowalls-datawalls-data-hanging-as-warning
Last change on this file since 6316bfa was 6316bfa, checked in by Olly Betts <olly@…>, 9 years ago

lib/checkshortcut.pl: If there's a shortcut clash, report letters
used in strings in the menu which aren't used for shortcuts, and
separately any ASCII letters which aren't used in the menu strings at
all.

  • Property mode set to 100755
File size: 1.7 KB
RevLine 
[46cb98f]1#!/usr/bin/perl -w
[be891ea]2require 5.008;
3use bytes;
[46cb98f]4use strict;
[be891ea]5
[46cb98f]6my %menu = ();
[aceb53e]7my $srcdir = $ENV{'srcdir'} || '';
8$srcdir .= '/' if $srcdir;
[6deca30]9
10open I, "<$srcdir../src/mainfrm.cc" or die $!;
[46cb98f]11while (<I>) {
[2b65003]12    m!(\w+)->Append[A-Za-z]*\(.*\(/\*.*?\*/(\d+)! && push @{$menu{$1}}, $2;
[46cb98f]13}
14close I;
15
[2b65003]16#for (sort keys %menu) { print "$_:".join("|", @{$menu{$_}})."\n" }
17
[6deca30]18my $exitcode = 0;
[46cb98f]19for my $lang (@ARGV) {
[6deca30]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 $!;
[46cb98f]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) {
[6316bfa]31        my %sc;
32        my %let;
[46cb98f]33        my $bad = 0;
34        for (@{$menu{$menu}}) {
[f4c18a9]35            my ($acc) = ($msg[$_] =~ /\&([\x00-\x7f]|[\xc2-\xdf].|[\xe0-\xef]..|[\xf0-\xf4]...)/);
[206c976]36            if (!defined $acc) {
37                print "Lang $lang : message $_ '$msg[$_]' has no shortcut\n";
[46cb98f]38            } else {
[206c976]39                $acc = lc $acc;
40                if (exists $sc{$acc}) {
41                    if (defined $hdr) {
42                        print $hdr;
43                        $hdr = undef;
44                    }
45                    print "Menu $menu : '$msg[$sc{$acc}]' and '$msg[$_]' both use shortcut '$acc'\n";
46                    $bad = 1;
47                } else {
48                    $sc{$acc} = $_;
49                }
[46cb98f]50            }
[6316bfa]51            # Tally available letters
52            while ($msg[$_] =~ /([A-Za-z]|[\xc2-\xdf].|[\xe0-\xef]..|[\xf0-\xf4]...)/g) {
53                ++$let{"\l$1"};
54            }
[46cb98f]55        }
56        if ($bad) {
[6316bfa]57            print "Unused letters: ", grep {!exists $sc{$_}} (sort keys %let), "\n";
58            print "Not-present ASCII letters: ", grep {!exists $let{$_}} ('a' .. 'z'), "\n";
[6deca30]59            $exitcode = 1;
[46cb98f]60        }
61    }
[6deca30]62    print "\n" unless defined $hdr;
[46cb98f]63}
[6deca30]64exit $exitcode;
Note: See TracBrowser for help on using the repository browser.