3 # $Id: accel.pl,v 1.2 2003/01/21 21:05:35 jacob Exp $
4 # Grotty script to check for clashes in the PuTTY config dialog keyboard
5 # accelerators in windlg.c, and to check the comments are still up to
8 # win_res.rc:1.59 (for global accelerators)
9 # winctrls.c:1.20 (for prefslist() hardcoded accelerators)
10 # usage: accel.pl [-q] [-v] [-f windlg-alt.c]
16 # Accelerators that nothing in create_controls() must use
17 # (see win_res.rc, windlg.c:GenericMainDlgProc())
18 my $GLOBAL_ACCEL = "acgoh";
23 # Sort a string of characters.
26 return join("",sort(split(//,$str)));
29 # Return duplicates in a sorted string of characters.
34 for (my $i=0; $i < length($str); $i++) {
36 $chr eq substr($str,$i,1)) {
39 $chr = substr($str,$i,1);
45 print @_ unless exists($opts{q});
54 # Having worked out stuff about a particular panel, check it for
57 my ($panel, $cmtkeys, $realkeys) = @_;
60 $scmt = sortstr
($cmtkeys);
61 $sreal = sortstr
($GLOBAL_ACCEL . $realkeys);
62 my @dups = dups
($sreal);
64 $ok = whinge
("$panel: accelerator clash(es): ",
65 join(", ", @dups), "\n") && $ok;
67 if ($scmt ne $sreal) {
68 $ok = whinge
("$panel: comment doesn't match reality ",
69 "([$GLOBAL_ACCEL] $realkeys)\n") && $ok;
71 if ($ok && exists($opts{v
})) {
72 mumble
("$panel: ok\n");
76 getopts
("qvf:", \
%opts);
77 my $windlg_c_name = "windlg.c";
78 $windlg_c_name = $opts{f
} if exists($opts{f
});
80 open WINDLG
, "<$windlg_c_name";
82 # Grotty ad-hoc parser (tm) state
93 # Look for the start of the function we're interested in.
94 if (m/create_controls\s*\(.*\)\s*$/) {
104 # We've run out of function. (Probably.)
105 # We should process any pending panel.
106 if (defined($panel)) {
107 process_panel
($panel, $cmt_accel, $real_accel);
112 if (m/^\s*if\s*\(panel\s*==\s*(\w+)panelstart\)/) {
113 # New panel. Now seems like a good time to process the previous
115 process_panel
($panel, $cmt_accel, $real_accel)
118 $cmt_accel = $real_accel = "";
122 next unless defined($panel);
124 # Some nasty hacks to get round the conditionalised stuff
125 # in the Session panel. This is probably the bit most likely
127 if ($panel eq "session") {
129 if (m/if\s*\(backends\[\w+\].backend\s*==\s*NULL\)/) {
130 do { $munch = <WINDLG
> } until ($munch =~ m/}\s*else\s*{/);
131 } elsif (m/^#ifdef\s+FWHACK/) {
132 do { $munch = <WINDLG
> } until ($munch =~ m/^#else/);
136 # Hack: winctrls.c:prefslist() has hard-coded "&Up" and "&Down"
137 # buttons. Take this into account.
138 if (m/\bprefslist *\(/) {
142 # Look for accelerator comment.
143 if (m
#/\* .* Accelerators used: (.*) \*/#) {
144 die "aiee, multiple comments in panel" if ($cmt_accel);
146 $cmt_accel =~ tr/[] //d; # strip ws etc
150 # Now try to find double-quoted strings.
154 while ($line =~ m/"/) {
157 # Be paranoid about \", since it does get used.
158 while ($line =~ m/(?:(\\)?"|(&)(.))/) {
162 # Found an accelerator. (Probably.)
163 $real_accel .= lc($3);
165 # Otherwise, found && -- ignore.
168 last unless defined($1);
169 # Otherwise, it's a \" quote.
181 die "That didn't look anything like windlg.c to me" if (!$seen_ctrl_fn);