From 2fed2fdf2db71e0360248bf297003be0e531a4aa Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Fri, 21 Jan 2005 09:42:47 +0000 Subject: minimal XkbModel support --- perl-install/keyboard.pm | 29 ++++++++++++++++++++++++++--- perl-install/standalone/keyboarddrake | 9 ++++++++- 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; } -- cgit v1.2.1