package keyboard; # $Id: keyboard.pm,v 1.127 2001/10/09 20:01:36 sbenedict Exp $ use common; use detect_devices; use run_program; use log; use c; my $KMAP_MAGIC = 0x8B39C07F; my %lang2keyboard = ( 'be' => 'by:80', 'be_BY'=> 'by:80', 'de_AT'=> 'de_nodeadkeys:70 de:50', 'de_BE'=> 'be:70 de_nodeadkeys:60 de:50', 'de_CH'=> 'ch_de:70 ch_fr:25 de_nodeadkeys:20 de:15', 'de_DE'=> 'de_nodeadkeys:70 de:50', 'en' => 'us:90 us_intl:50', 'en_US'=> 'us:90 us_intl:50', 'en_GB'=> 'uk:89 us:60 us_intl:50', 'en_IE'=> 'uk:89 us:60 us_intl:50', 'eo' => 'us_intl:89 dvorak:20', 'fr_BE'=> 'be:85 fr:5', 'fr_CA'=> 'qc:85 fr:5', 'fr_CH'=> 'ch_fr:70 ch_de:15 fr:10', 'fr_FR'=> 'fr:90', 'kk'=>'kz:90', 'kk_KZ'=>'kz:90', 'pt_BR'=> 'br:80 la:20 pt:10 us_intl:30', 'pt_PT'=> 'pt:80', 'ru' => 'ruwin_ct_sh:80 ruwin_cplk:50 ruwin_alt:40 ruwin_ctrl:30 ru:10 ru_cplk:20 ru_alt:30 ru_ctrl:40 ru_yawerty:20', 'ru_RU'=> 'ruwin_ct_sh:80 ruwin_cplk:50 ruwin_alt:40 ruwin_ctrl:30 ru:10 ru_cplk:20 ru_alt:30 ru_ctrl:40 ru_yawerty:20', 'uk' => 'ua:85 ru_group3:80 rua:75 ruan:70 ru:50 ru_yawerty:40', 'uk_UA'=> 'ua:85 ru_group3:80 rua:75 ruan:70 ru:50 ru_yawerty:40', ); my %keyboards = ( arch() =~ /^sparc/ ? ( "de" => [ __("German"), "sunt5-de-latin1", "de" ], "dvorak" => [ __("Dvorak"), "sundvorak", "dvorak" ], "fr" => [ __("French"), "sunt5-fr-latin1", "fr" ], "ru" => [ __("Russian"), "sunt5-ru", "ru" ], # TODO: check the console map "uk" => [ __("UK keyboard"), "sunt5-uk", "gb" ], "us" => [ __("US keyboard"), "sunkeymap", "us" ], ) : ( "be" => [ __("Belgian"), "be2-latin1", "be" ], "br" => [ __("Brazilian (ABNT-2)"), "br-abnt2", "br" ], "by" => [ __("Belarusian"), "by", "byru" ], "ch_de" => [ __("Swiss (German layout)"), "sg-latin1", "de_CH" ], "ch_fr" => [ __("Swiss (French layout)"), "fr_CH-latin1", "fr_CH" ], "de" => [ __("German"), "de-latin1", "de" ], "de_nodeadkeys" => [ __("German (no dead keys)"), "de-latin1-nodeadkeys", "de(nodeadkeys)" ], "fr" => [ __("French"), "fr-latin1", "fr" ], #There is no XKB korean file yet; but using xmodmap one disables # some functioanlity; "us" used for XKB until this is fixed "kz" => [ __("Kazakh"), "kazakh", "kz" ], "pt" => [ __("Portuguese"), "pt-latin1", "pt" ], "qc" => [ __("Canadian (Quebec)"), "qc-latin1","ca_enhanced" ], "ru" => [ __("Russian(Ctrl-Shift)"), "ru_ct_sh", "ru" ], "ru_cplk" => [ __("Russian, CapsLock"), "ru_cplk", "ru" ], "ru_alt" => [ __("Russian, RghtAlt"), "ru_alt", "ru" ], "ru_ctrl" => [ __("Russian, RghtCtrl"), "ru_ctrl", "ru" ], "ruwin_ct_sh" => [ __("Russian Win, Ctrl-Shift"), "ruwin_ct_sh", "ru" ], "ruwin_cplk" => [ __("Russian Win, CapsLock"), "ruwin_cplk", "ru" ], "ruwin_alt" => [ __("Russian Win, RightAlt"), "ruwin_alt", "ru" ], "ruwin_ctrl" => [ __("Russian Win, RightCtrl"), "ruwin_ctrl", "ru" ], "ru_yawerty" => [ __("Russian (Yawerty)"),"ru-yawerty","ru_yawerty" ], # TODO: console map # TODO: console map "ua" => [ __("Ukrainian"), "ua", "ua" ], "rua" => [ __("Ukrainian with Russian (rua)"), "ua", "rua" ], "ruan" => [ __("Ukrainian with Russian (ruan)"), "ua", "ruan" ], "ru_group3" => [ __("Ukrainian with Russian (ru_group3)"), "ua", "ru_group3" ], "uk" => [ __("UK keyboard"), "uk", "gb" ], "us" => [ __("US keyboard"), "us", "us" ], "us_intl" => [ __("US keyboard (international)"), "us-latin1", "us_intl" ], ), ); sub keyboards { keys %keyboards } sub keyboard2text { $keyboards{$_[0]} && $keyboards{$_[0]}[0] } #sub keyboard2kmap { $keyboards{$_[0]} && $keyboards{$_[0]}[1] } sub keyboard2xkb { $keyboards{$_[0]} && $keyboards{$_[0]}[2] } sub keyboard2xkb_addon { $keyboards{$_[0]} && $keyboards{$_[0]}[1] } sub keyboard2kmap { my $addon=$_[1]; $addon =~ s/[^.]+\.(.+)/$1/ or $addon = ""; if ($keyboards{$_[0]}){ if ($addon){ return $keyboards{$_[0]}[1]."-$addon"; }else{ return $keyboards{$_[0]}[1]; } } } sub loadkeys_files { my ($warn) = @_; my $archkbd = arch() =~ /^sparc/ ? "sun" : arch() =~ /i.86/ ? "i386" : arch() =~ /ppc/ ? "mac" : arch(); my $p = "/usr/lib/kbd/keymaps/$archkbd"; my $post = ".kmap.gz"; my %trans = ("cz-latin2" => "cz-lat2"); my %find_file; foreach my $dir (all($p)) { $find_file{$dir} = ''; foreach (all("$p/$dir")) { $find_file{$_} && $warn and warn "file $_ is both in $find_file{$_} and $dir\n"; $find_file{$_} = "$p/$dir/$_"; } } my (@l, %l); foreach (values %keyboards) { local $_ = $trans{$_->[1]} || $_->[1]; my $l = $find_file{"$_$post"} || $find_file{first(/(..)/) . $post}; print STDERR "unknown $_\n" if $warn && !$l; $l or next; push @l, $l; foreach (`zgrep include $l | grep "^include"`) { /include\s+"(.*)"/ or die "bad line $_"; @l{grep { -e $_ } ("$p/$1.inc.gz")} = (); } } @l, keys %l, grep { -e $_ } map { "$p/$_.inc.gz" } qw(compose euro windowkeys linux-keys-bare); } sub unpack_keyboards { my ($k) = @_ or return; [ grep { my $b = $keyboards{$_->[0]}; $b or log::l("bad keyboard $_->[0] in %keyboard::lang2keyboard"); $b; } map { [ split ':' ] } split ' ', $k ]; } sub lang2keyboards { my ($l) = @_; my $li = unpack_keyboards($lang2keyboard{substr($l, 0, 5)}) || [ $keyboards{$l} && $l || "us" ]; $li->[0][1] ||= 100; $li; } sub lang2keyboard { my ($l) = @_; my $kb = lang2keyboards($l)->[0][0]; $keyboards{$kb} ? $kb : "us"; } sub load { my ($keymap) = @_; return if $::testing; my ($magic, @keymaps) = unpack "I i" . c::MAX_NR_KEYMAPS() . "a*", $keymap; $keymap = pop @keymaps; $magic != $KMAP_MAGIC and die "failed to read kmap magic"; local *F; sysopen F, "/dev/console", 2 or die "failed to open /dev/console: $!"; my $count = 0; foreach (0 .. c::MAX_NR_KEYMAPS() - 1) { $keymaps[$_] or next; my @keymap = unpack "s" . c::NR_KEYS() . "a*", $keymap; $keymap = pop @keymap; my $key = -1; foreach my $value (@keymap) { $key++; c::KTYP($value) != c::KT_SPEC() or next; ioctl(F, c::KDSKBENT(), pack("CCS", $_, $key, $value)) or die "keymap ioctl failed ($_ $key $value): $!"; } $count++; } } sub xmodmap_file { my ($keyboard) = @_; my $f = "$ENV{SHARE_PATH}/xmodmap/xmodmap.$keyboard"; if (! -e $f) { eval { require packdrake; my $packer = new packdrake("$ENV{SHARE_PATH}/xmodmap.cz2", quiet => 1); $packer->extract_archive("/tmp", "xmodmap.$keyboard"); }; $f = "/tmp/xmodmap.$keyboard"; } -e $f && $f; } sub setup { return if arch() =~ /^sparc/; if (arch() =~ /ppc/ && !$::testing && $ENV{DISPLAY}) { log::l("Fixing Mac keyboard"); run_program::run('xmodmap', "-e", "keycode 59 = BackSpace" ); run_program::run('xmodmap', "-e", "keycode 131 = Shift_R" ); run_program::run('xmodmap', "-e", "add shift = Shift_R" ); return; } my ($keyboard) = @_; my $o = $keyboards{$keyboard} or return; log::l("loading keymap $o->[1]"); if (-e (my $f = "$ENV{SHARE_PATH}/keymaps/$o->[1].bkmap")) { load(scalar cat_($f)); } else { local *F; if (my $pid = open F, "-|") { local $/ = undef; eval { load(join('', )) }; waitpid $pid, 0; } else { eval { require packdrake; my $packer = new packdrake("$ENV{SHARE_PATH}/keymaps.cz2", quiet => 1); $packer->extract_archive(undef, "$o->[1].bkmap"); }; c::_exit(0); } } my $f = xmodmap_file(substr($keyboard,0,2)); #hack for all lang related keyboards eval { run_program::run('xmodmap', $f) } if $f && !$::testing && $ENV{DISPLAY}; } sub write { my ($prefix, $keyboard, $charset, $isNotDelete,$lang ) = @_; my $config = read_raw($prefix); put_in_hash($config, { KEYTABLE => keyboard2kmap($keyboard,$lang), KBCHARSET => $charset, }); add2hash_($config, { DISABLE_WINDOWS_KEY => bool2yesno(detect_devices::isLaptop()), BACKSPACE => $isNotDelete ? "BackSpace" : "Delete", }); setVarsInSh("$prefix/etc/sysconfig/keyboard", $config); run_program::rooted($prefix, "dumpkeys > /etc/sysconfig/console/default.kmap") or log::l("dumpkeys failed"); if (arch() =~ /ppc/) { my $s = "dev.mac_hid.keyboard_sends_linux_keycodes = 1"; substInFile { $_ = '' if /^\Qdev.mac_hid.keyboard_sends_linux_keycodes/; $_ .= $s if eof; } "$prefix/etc/sysctl.conf"; } } sub read_raw { my ($prefix) = @_; my %config = getVarsFromSh("$prefix/etc/sysconfig/keyboard"); \%config; } sub read { my ($prefix) = @_; my $keytable = read_raw($prefix)->{KEYTABLE}; keyboard2kmap($_) eq $keytable and return $_ foreach keys %keyboards; $keyboards{$keytable} && $keytable; } 1;