3 # $Id: accel.pl,v 1.1 2002/03/10 21:56:55 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
6 # date. Based on windlg.c:1.177 & win_res.rc:1.56.
7 # usage: accel.pl [-q] [-v] [-f windlg-alt.c]
13 # Accelerators that nothing in create_controls() must use
14 # (see win_res.rc, windlg.c:GenericMainDlgProc())
15 my $GLOBAL_ACCEL = "acgoh";
20 # Sort a string of characters.
23 return join("",sort(split(//,$str)));
26 # Return duplicates in a sorted string of characters.
31 for (my $i=0; $i < length($str); $i++) {
33 $chr eq substr($str,$i,1)) {
36 $chr = substr($str,$i,1);
42 print @_ unless exists($opts{q});
51 # Having worked out stuff about a particular panel, check it for
54 my ($panel, $cmtkeys, $realkeys) = @_;
57 $scmt = sortstr ($cmtkeys);
58 $sreal = sortstr ($GLOBAL_ACCEL . $realkeys);
59 my @dups = dups($sreal);
61 $ok = whinge("$panel: accelerator clash(es): ",
62 join(", ", @dups), "\n") && $ok;
64 if ($scmt ne $sreal) {
65 $ok = whinge("$panel: comment doesn't match reality ",
66 "([$GLOBAL_ACCEL] $realkeys)\n") && $ok;
68 if ($ok && exists($opts{v})) {
69 mumble("$panel: ok\n");
73 getopts("qvf:", \%opts);
74 my $windlg_c_name = "windlg.c";
75 $windlg_c_name = $opts{f} if exists($opts{f});
77 open WINDLG, "<$windlg_c_name";
79 # Grotty ad-hoc parser (tm) state
90 # Look for the start of the function we're interested in.
91 if (m/create_controls\s*\(.*\)\s*$/) {
101 # We've run out of function. (Probably.)
102 # We should process any pending panel.
103 if (defined($panel)) {
104 process_panel($panel, $cmt_accel, $real_accel);
109 if (m/^\s*if\s*\(panel\s*==\s*(\w+)panelstart\)/) {
110 # New panel. Now seems like a good time to process the previous
112 process_panel ($panel, $cmt_accel, $real_accel)
115 $cmt_accel = $real_accel = "";
119 next unless defined($panel);
121 # Some nasty hacks to get round the conditionalised stuff
122 # in the Session panel. This is probably the bit most likely
124 if ($panel eq "session") {
126 if (m/if\s*\(backends\[\w+\].backend\s*==\s*NULL\)/) {
127 do { $munch = <WINDLG> } until ($munch =~ m/}\s*else\s*{/);
128 } elsif (m/^#ifdef\s+FWHACK/) {
129 do { $munch = <WINDLG> } until ($munch =~ m/^#else/);
133 # Look for accelerator comment.
134 if (m#/\* .* Accelerators used: (.*) \*/#) {
135 die "aiee, multiple comments in panel" if ($cmt_accel);
137 $cmt_accel =~ tr/[] //d; # strip ws etc
141 # Now try to find double-quoted strings.
145 while ($line =~ m/"/) {
148 # Be paranoid about \", since it does get used.
149 while ($line =~ m/(?:(\\)?"|(&)(.))/) {
153 # Found an accelerator. (Probably.)
154 $real_accel .= lc($3);
156 # Otherwise, found && -- ignore.
159 last unless defined($1);
160 # Otherwise, it's a \" quote.
172 die "That didn't look anything like windlg.c to me" if (!$seen_ctrl_fn);