diff --git a/contrib/accel.pl b/contrib/accel.pl new file mode 100755 index 00000000..e37b029e --- /dev/null +++ b/contrib/accel.pl @@ -0,0 +1,174 @@ +#! /usr/bin/perl -w + +# $Id: accel.pl,v 1.1 2002/03/10 21:56:55 jacob Exp $ +# Grotty script to check for clashes in the PuTTY config dialog keyboard +# accelerators in windlg.c, and to check the comments are still up to +# date. Based on windlg.c:1.177 & win_res.rc:1.56. +# usage: accel.pl [-q] [-v] [-f windlg-alt.c] + +use strict; +use English; +use Getopt::Std; + +# Accelerators that nothing in create_controls() must use +# (see win_res.rc, windlg.c:GenericMainDlgProc()) +my $GLOBAL_ACCEL = "acgoh"; + +my $all_ok = 1; +my %opts = (); + +# Sort a string of characters. +sub sortstr { + my ($str) = @_; + return join("",sort(split(//,$str))); +} + +# Return duplicates in a sorted string of characters. +sub dups { + my ($str) = @_; + my %dups = (); + my $chr = undef; + for (my $i=0; $i < length($str); $i++) { + if (defined($chr) && + $chr eq substr($str,$i,1)) { + $dups{$chr} = 1; + } + $chr = substr($str,$i,1); + } + return keys(%dups); +} + +sub mumble { + print @_ unless exists($opts{q}); +} + +sub whinge { + mumble(@_); + $all_ok = 0; + return 0; +} + +# Having worked out stuff about a particular panel, check it for +# plausibility. +sub process_panel { + my ($panel, $cmtkeys, $realkeys) = @_; + my ($scmt, $sreal); + my $ok = 1; + $scmt = sortstr ($cmtkeys); + $sreal = sortstr ($GLOBAL_ACCEL . $realkeys); + my @dups = dups($sreal); + if (@dups) { + $ok = whinge("$panel: accelerator clash(es): ", + join(", ", @dups), "\n") && $ok; + } + if ($scmt ne $sreal) { + $ok = whinge("$panel: comment doesn't match reality ", + "([$GLOBAL_ACCEL] $realkeys)\n") && $ok; + } + if ($ok && exists($opts{v})) { + mumble("$panel: ok\n"); + } +} + +getopts("qvf:", \%opts); +my $windlg_c_name = "windlg.c"; +$windlg_c_name = $opts{f} if exists($opts{f}); + +open WINDLG, "<$windlg_c_name"; + +# Grotty ad-hoc parser (tm) state +my $in_ctrl_fn = 0; +my $seen_ctrl_fn = 0; +my $panel; +my $cmt_accel; +my $real_accel; + +while () { + chomp; + if (!$in_ctrl_fn) { + + # Look for the start of the function we're interested in. + if (m/create_controls\s*\(.*\)\s*$/) { + $in_ctrl_fn = 1; + $seen_ctrl_fn = 1; + $panel = undef; + next; + } + + } else { + + if (m/^}\s*$/) { + # We've run out of function. (Probably.) + # We should process any pending panel. + if (defined($panel)) { + process_panel($panel, $cmt_accel, $real_accel); + } + $in_ctrl_fn = 0; + last; + } + if (m/^\s*if\s*\(panel\s*==\s*(\w+)panelstart\)/) { + # New panel. Now seems like a good time to process the previous + # one (if any). + process_panel ($panel, $cmt_accel, $real_accel) + if defined($panel); + $panel = $1; + $cmt_accel = $real_accel = ""; + next; + } + + next unless defined($panel); + + # Some nasty hacks to get round the conditionalised stuff + # in the Session panel. This is probably the bit most likely + # to break. + if ($panel eq "session") { + my $munch; + if (m/if\s*\(backends\[\w+\].backend\s*==\s*NULL\)/) { + do { $munch = } until ($munch =~ m/}\s*else\s*{/); + } elsif (m/^#ifdef\s+FWHACK/) { + do { $munch = } until ($munch =~ m/^#else/); + } + } + + # Look for accelerator comment. + if (m#/\* .* Accelerators used: (.*) \*/#) { + die "aiee, multiple comments in panel" if ($cmt_accel); + $cmt_accel = lc $1; + $cmt_accel =~ tr/[] //d; # strip ws etc + next; + } + + # Now try to find double-quoted strings. + { + my $line = $ARG; + # Opening quote. + while ($line =~ m/"/) { + $line = $POSTMATCH; + my $str = $line; + # Be paranoid about \", since it does get used. + while ($line =~ m/(?:(\\)?"|(&)(.))/) { + $line = $POSTMATCH; + if (defined($2)) { + if ($3 ne "&") { + # Found an accelerator. (Probably.) + $real_accel .= lc($3); + } + # Otherwise, found && -- ignore. + } else { + # It's an end quote. + last unless defined($1); + # Otherwise, it's a \" quote. + # Yum. + } + } + } + } + } + +} + +close WINDLG; + +die "That didn't look anything like windlg.c to me" if (!$seen_ctrl_fn); + +exit (!$all_ok);