This script has been unnecessary for some time; since the config box revamp,

accelerator clashes have been checked for at run-time.

[originally from svn r3053]

contrib/accel.pl

@@ -1,183 +0,0 @@
-#! /usr/bin/perl -w
-
-# $Id: accel.pl,v 1.2 2003/01/21 21:05:35 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.201
-#   win_res.rc:1.59 (for global accelerators)
-#   winctrls.c:1.20 (for prefslist() hardcoded accelerators)
-# 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 (<WINDLG>) {
-    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 = <WINDLG> } until ($munch =~ m/}\s*else\s*{/);
-            } elsif (m/^#ifdef\s+FWHACK/) {
-                do { $munch = <WINDLG> } until ($munch =~ m/^#else/);
-            }
-        }
-
-	# Hack: winctrls.c:prefslist() has hard-coded "&Up" and "&Down"
-	# buttons. Take this into account.
-	if (m/\bprefslist *\(/) {
-	    $real_accel .= "ud";
-	}
-
-        # 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);