source: git/lib/checkshortcut.pl @ 5d4e21e

debian/1.4.1-1
Last change on this file since 5d4e21e was 1065e69, checked in by Olly Betts <olly@…>, 7 years ago

lib/checkshortcut.pl: Strip off accelerator before looking at
shortcuts, and don't offer ellipses as a potential shortcut.

  • Property mode set to 100755
File size: 1.8 KB
Line 
1#!/usr/bin/perl -w
2require 5.008;
3use bytes;
4use strict;
5
6my %menu = ();
7my $srcdir = $ENV{'srcdir'} || '';
8$srcdir .= '/' if $srcdir;
9
10open I, "<$srcdir../src/mainfrm.cc" or die $!;
11while (<I>) {
12    m!(\w+)->Append[A-Za-z]*\(.*\(/\*.*?\*/(\d+)! && push @{$menu{$1}}, $2;
13}
14close I;
15
16#for (sort keys %menu) { print "$_:".join("|", @{$menu{$_}})."\n" }
17
18my $exitcode = 0;
19for 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}
70exit $exitcode;
Note: See TracBrowser for help on using the repository browser.