keytests: Allow definition of shortcuts for the test.

[features.git] / lib / scripts / prefTest.pl.in

diff --git a/lib/scripts/prefTest.pl.in b/lib/scripts/prefTest.pl.in
index 08a6c0c2f56f2371156a1432dff052b33774df09..1d8aa90e03237899b5fb8d7723845dd09fa4b422 100755 (executable)
--- a/lib/scripts/prefTest.pl.in
+++ b/lib/scripts/prefTest.pl.in
@@ -14,6 +14,13 @@ my %allowedKeys = (
   "use_converter_needauth" => ["true", "false"],
     );
 
+# Bindings used by some tests
+# used file is "$userdir/bind/user.bind"
+my %bindings = (
+  # Empty for now, example below
+  # "A-h" => ["dialog-hide", "findreplaceadv"],
+  );
+
 chdir($bindir);
 
 # Parse Arguments for strings to substitute
@@ -52,6 +59,7 @@ for my $arg (@ARGV) {
     }
   }
 }
+
 if (%Subst) { # Try to do something only if a substitute is requested
   if (open(FO, '>', "$userdir/preferences.tmp")) {
     if (open(FI, "$userdir/preferences")) {
@@ -74,6 +82,43 @@ if (%Subst) { # Try to do something only if a substitute is requested
   }
 }
 
+if (open(FO, '>', "$userdir/userbind.tmp")) {
+  my %used = ();
+  if (open(FI, "$userdir/bind/user.bind")) {
+    while (my $l = <FI>) {
+      my $found = 0;
+      for my $k (keys %bindings) {
+       if ($l =~ /^\s*\\bind\s+\"$k\"/) {
+         $found = 1;
+         if (! defined($used{$k})) {
+           $used{$k} = 1;
+           $l = "\\bind \"$k\" \"" . join(' ', @{$bindings{$k}}) . "\"\n";
+           print FO $l;
+           last;
+         }
+       }
+       print FO $l if (! $found);
+      }
+    }
+    close(FI);
+  }
+  else {
+    print FO "## This file is automatically generated by lyx\n";
+    print FO "## All modifications will be lost\n";
+    print FO "\n\n";
+    print FO "Format 4\n\n";
+  }
+  for my $k (keys %bindings) {
+    if (! defined($used{$k})) {
+      $used{$k} = 1;
+      my $l = "\\bind \"$k\" \"" . join(' ', @{$bindings{$k}}) . "\"\n";
+      print FO $l;
+    }
+  }
+  close(FO);
+  rename("$userdir/userbind.tmp", "$userdir/bind/user.bind");
+}
+
 my $res = 0;
 if (@ctestpars) {
   $res = system("ctest", @ctestpars);