minimal XkbModel support

2 files changed, 34 insertions, 4 deletions

diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index b2df6a549..104cf11dd 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -365,6 +365,11 @@ sub keyboard2text { keyboard2one($_[0], 0) }
 sub keyboard2kmap { keyboard2one($_[0], 1) }
 sub keyboard2xkb  { keyboard2one($_[0], 2) }
 
+sub xkb_models() {
+    my $models = parse_xkb_rules()->{model};
+    [ map { $_->[0] } @$models ], { map { @$_ } @$models };
+}
+
 sub grp_toggles {
     my ($keyboard) = @_;
     keyboard2one($keyboard, 3) or return;
@@ -482,15 +487,33 @@ sub load {
     } @$tables_given;
 }
 
+sub parse_xkb_rules() {
+    my $cat;
+    my %l;
+    my $lst_file = "$::prefix/usr/X11R6/lib/X11/xkb/rules/xorg.lst";
+    foreach (cat_($lst_file)) {
+	next if m!^\s*//! || m!^\s*$!;
+	chomp;
+	if (/^\!\s*(\S+)$/) {
+	    $cat = $1;
+	} elsif (/^\s*(\w\S*)\s+(.*)/) {
+	    push @{$l{$cat}}, [ $1, $2 ];
+	} else {
+	    log::l("parse_xkb_rules:$lst_file: bad line $_");
+	}
+    }
+    \%l;
+}
+
 sub keyboard2full_xkb {
     my ($keyboard) = @_;
 
     my $XkbLayout = keyboard2xkb($keyboard) or return { XkbDisable => '' };
 
-    my $XkbModel = 
-      arch() =~ /sparc/ ? 'sun' :
+    my $XkbModel = $keyboard->{XkbModel} ||
+      (arch() =~ /sparc/ ? 'sun' :
 	$XkbLayout eq 'jp' ? 'jp106' : 
-	$XkbLayout eq 'br' ? 'abnt2' : 'pc105';
+	$XkbLayout eq 'br' ? 'abnt2' : 'pc105');
 
     {
 	XkbLayout => 
diff --git a/perl-install/standalone/keyboarddrake b/perl-install/standalone/keyboarddrake
index fbb46da7e..01de6bf50 100755
--- a/perl-install/standalone/keyboarddrake
+++ b/perl-install/standalone/keyboarddrake
@@ -20,6 +20,9 @@ if (my ($kb) = grep { !/^-/ } @ARGV) {
 } else {
     $in = 'interactive'->vnew('su');
 
+    my ($xkb_models, $model2text) = keyboard::xkb_models();
+    $keyboard->{XkbModel} ||= 'pc105';
+
   choose:
     $in->ask_from(N("Keyboard"),
 		  N("Please, choose your keyboard layout."),
@@ -27,7 +30,11 @@ if (my ($kb) = grep { !/^-/ } @ARGV) {
 		      format => sub { translate(keyboard::KEYBOARD2text($_[0])) },
 		      list => [ keyboard::KEYBOARDs() ],
 		      type => 'list',
-		  } ]) or goto end;
+		    },
+		    { val => \$keyboard->{XkbModel},
+		      format => sub { $model2text->{$_[0]} },
+		      list => $xkb_models },
+		]) or goto end;
 
     keyboard::group_toggle_choose($in, $keyboard) or goto choose;
 }