home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / keyboard.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  6.3 KB  |  231 lines
  1.  
  2. package keyboard;
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10. use common qw(:common :system :file);
  11. use run_program;
  12. use commands;
  13. use log;
  14. use c;
  15.  
  16.  
  17.  
  18.  
  19.  
  20. my $KMAP_MAGIC = 0x8B39C07F;
  21.  
  22.  
  23. my %lang2keyboard =
  24. (
  25.   'af' => 'us_intl',
  26.   'bg' => 'bg',
  27.   'br' => 'fr',
  28.   'ca' => 'es',
  29.   'cs' => 'cz',
  30.   'cy' => 'uk',
  31.   'da' => 'dk',
  32.   'de' => 'de',
  33. 'de_AT'=> 'de',
  34. 'de_CH'=> 'ch_de',
  35. 'de_DE'=> 'de', 
  36.   'el' => 'gr',
  37.   'en' => 'us',
  38. 'en_US'=> 'us',
  39. 'en_GB'=> 'uk',
  40.   'eo' => 'us_intl',
  41.   'es' => 'es',
  42.   'es@tradicional' => 'es',
  43. 'es_AR'=> 'la',
  44. 'es_ES'=> 'es',
  45. 'es_MX'=> 'la',
  46.   'et' => 'ee',
  47.   'eu' => 'es',
  48.   'fi' => 'fi',
  49.   'fr' => 'fr',
  50. 'fr_BE'=> 'be',
  51. 'fr_CA'=> 'qc',
  52. 'fr_CH'=> 'ch_fr',
  53. 'fr_FR'=> 'fr',
  54.   'ga' => 'uk',
  55.   'gl' => 'es',
  56.   'he' => 'il',
  57.   'hr' => 'yu',
  58.   'hu' => 'hu',
  59.   'hy' => 'am',
  60.   'is' => 'is',
  61.   'it' => 'it',
  62.   'ka' => 'ge_la',
  63.   'lt' => 'lt',
  64.   'nl' => 'nl',
  65. 'nl_BE'=> 'be',
  66. 'nl_NL'=> 'nl',
  67.   'no' => 'no',
  68.   'no@nynorsk' => 'no',
  69.   'oc' => 'fr',
  70.   'pl' => 'pl',
  71.   'pt' => 'pt',
  72. 'pt_BR'=> 'br',
  73. 'pt_PT'=> 'pt',
  74.   'ru' => 'ru',
  75.   'sk' => 'sk',
  76.   'sl' => 'si',
  77.   'sr' => 'yu',
  78.   'sv' => 'se',
  79.   'th' => 'th',
  80.   'tr' => 'tr_q',
  81.   'uk' => 'ua',
  82.   'wa' => 'be',
  83. );
  84.  
  85.  
  86.  
  87. my %keyboards = (
  88.  "am" => [ __("Armenian"),       "am-armscii8", "am" ],
  89.  "be" => [ __("Belgian"),        "be-latin1",   "be" ],
  90.  "bg" => [ __("Bulgarian"),      "bg",          "bg" ],
  91.  "br" => [ __("Brazilian"),      "br-abnt2",    "br" ],
  92.  "ch_de" => [ __("Swiss (French layout)"), "fr_CH-latin1", "fr_CH" ],
  93.  "ch_fr" => [ __("Swiss (German layout)"), "sg-latin1", "de_CH" ],
  94.  "cz" => [ __("Czech"),          "cz-latin2",   "cs" ],
  95.  "de" => [ __("German"),         "de-latin1",   "de" ],
  96.  "dk" => [ __("Danish"),         "dk-latin1",   "dk" ],
  97.  "dvorak" => [ __("Dvorak"),     "pc-dvorak-latin1", "dvorak" ],
  98.  "ee" => [ __("Estonian"),       "ee-latin9",   "ee" ],
  99.  "es" => [ __("Spanish"),        "es-latin1",   "es" ],
  100.  "fi" => [ __("Finnish"),        "fi-latin1",   "fi" ],
  101.  "fr" => [ __("French"),         "fr-latin1",   "fr" ],
  102.  "ge_ru"=>[__("Georgian (\"Russian\" layout)"),"ge_ru-georgian_academy","ge_ru"],
  103.  "ge_la"=>[__("Georgian (\"Latin\" layout)"),"ge_la-georgian_academy","ge_la"],
  104.  "gr" => [ __("Greek"),          "gr-8859_7",   "gr" ],
  105.  "hu" => [ __("Hungarian"),      "hu-latin2",   "hu" ],
  106.  "il" => [ __("Israeli"),        "il-8859_8",   "il" ],
  107.  "il_phonetic" => [ __("Israeli (Phonetic)"),"hebrew",   "il_phonetic" ],
  108.  "is" => [ __("Icelandic"),      "is-latin1",   "is" ],
  109.  "it" => [ __("Italian"),        "it-latin1",   "it" ],
  110.  "la" => [ __("Latin American"), "la-latin1",   "la" ],
  111.  "nl" => [ __("Dutch"),          "nl-latin1",   "nl" ],
  112.  "lt" => [ __("Lithuanian AZERTY"), "lt-latin7","lt" ],
  113.  "lt_b" => [ __("Lithuanian \"number row\" QWERTY"), "ltb-latin7", "lt_b" ],
  114.  "lt_p" => [ __("Lithuanian \"phonetic\" QWERTY"), "ltp-latin7", "lt_p" ],
  115.  "no" => [ __("Norwegian"),      "no-latin1",   "no" ],
  116.  "pl" => [ __("Polish (qwerty layout)"),        "pl", "pl" ],
  117.  "pl2" => [ __("Polish (qwertz layout)"),       "pl-latin2", "pl" ],
  118.  "pt" => [ __("Portuguese"),     "pt-latin1",   "pt" ],
  119.  "qc" => [ __("Canadian (Quebec)"), "qc-latin1","ca_enhanced" ],
  120.  "ru" => [ __("Russian"),        "ru4",         "ru" ],
  121.  "ru_yawerty" => [ __("Russian (Yawerty)"),"ru-yawerty","ru_yawerty" ],
  122.  "se" => [ __("Swedish"),        "se-latin1",   "se_SE" ],
  123.  "si" => [ __("Slovenian"),      "slovene",     "si" ],
  124.  "sk" => [ __("Slovakian"),      "sk-qwertz",   "czsk" ],
  125.  "th" => [ __("Thai keyboard"),  "th",          "th" ],
  126.  "tr_f" => [ __("Turkish (traditional \"F\" model)"), "trf", "tr_f" ],
  127.  "tr_q" => [ __("Turkish (modern \"Q\" model)"), "tr_q-latin5", "tr_q" ],
  128.  "ua" => [ __("Ukrainian"),      "ua",           "ua" ],
  129.  "uk" => [ __("UK keyboard"),    "uk",           "gb" ],
  130.  "us" => [ __("US keyboard"),    "us",           "us" ],
  131.  "us_intl" => [ __("US keyboard (international)"), "us-latin1", "us_intl" ],
  132.  "yu" => [ __("Yugoslavian (latin layout)"), "sr", "yu" ],
  133. );
  134.  
  135.  
  136.  
  137.  
  138. sub list { map { $_->[0] } values %keyboards }
  139. sub xmodmaps { keys %keyboards }
  140. sub keyboard2text { $keyboards{$_[0]} && $keyboards{$_[0]}[0] }
  141. sub keyboard2kmap { $keyboards{$_[0]} && $keyboards{$_[0]}[1] }
  142. sub keyboard2xkb  { $keyboards{$_[0]} && $keyboards{$_[0]}[2] }
  143. sub text2keyboard {
  144.     my ($t) = @_;
  145.     while (my ($k, $v) = each %keyboards) {
  146.         lc($v->[0]) eq lc($t) and return $k;
  147.     }
  148.     die "unknown keyboard $t";
  149. }
  150.  
  151.  
  152. sub lang2keyboard($) {
  153.     local ($_) = @_;
  154.     $lang2keyboard{$_} || $keyboards{$_} && $_ || "us"; 
  155. }
  156.  
  157. sub load($) {
  158.     my ($keymap) = @_;
  159.  
  160.     my ($magic, @keymaps) = unpack "I i" . c::MAX_NR_KEYMAPS() . "a*", $keymap;
  161.     $keymap = pop @keymaps;
  162.  
  163.     $magic != $KMAP_MAGIC and die "failed to read kmap magic";
  164.  
  165.     local *F;
  166.     sysopen F, "/dev/console", 2 or die "failed to open /dev/console: $!";
  167.  
  168.     my $count = 0;
  169.     foreach (0 .. c::MAX_NR_KEYMAPS() - 1) {
  170.     $keymaps[$_] or next;
  171.  
  172.     my @keymap = unpack "s" . c::NR_KEYS() . "a*", $keymap;
  173.     $keymap = pop @keymap;
  174.  
  175.     my $key = -1;
  176.     foreach my $value (@keymap) {
  177.         $key++;
  178.         c::KTYP($value) != c::KT_SPEC() or next;
  179.         ioctl(F, c::KDSKBENT(), pack("CCS", $_, $key, $value)) or die "keymap ioctl failed ($_ $key $value): $!";
  180.      }
  181.     $count++;
  182.     }
  183.     
  184. }
  185.  
  186. sub xmodmap_file {
  187.     my ($keyboard) = @_;
  188.     my $f = "/usr/share/xmodmap/xmodmap.$keyboard";
  189.     if (! -e $f) {
  190.     run_program::run("extract_archive", "/usr/share/xmodmap", '/tmp', "xmodmap.$keyboard");
  191.     $f = "/tmp/xmodmap.$keyboard";
  192.     }
  193.     $f;
  194. }
  195.  
  196. sub setup($) {
  197.     my ($keyboard) = @_;
  198.     my $o = $keyboards{$keyboard} or return;
  199.  
  200.     log::l("loading keymap $o->[1]");
  201.     if (-e (my $f = "/usr/share/keymaps/$o->[1].kmap")) {
  202.     load(cat_($f));
  203.     } else {
  204.     local *F;
  205.     open F, "extract_archive /usr/share/keymaps '' $o->[1].kmap |";
  206.     local $/ = undef;
  207.     eval { load(<F>) };
  208.     }
  209.     my $f = xmodmap_file($keyboard);
  210.     eval { run_program::run('xmodmap', $f) } unless $::testing || !$f;
  211. }
  212.  
  213. sub write($$;$) {
  214.     my ($prefix, $keyboard, $isNotDelete) = @_;
  215.  
  216.     setVarsInSh("$prefix/etc/sysconfig/keyboard", { KEYTABLE => keyboard2kmap($keyboard), $isNotDelete ? () : (BACKSPACE => "Delete") });
  217.     run_program::rooted($prefix, "dumpkeys > /etc/sysconfig/console/default.kmap") or die "dumpkeys failed";
  218. }
  219.  
  220. sub read($) {
  221.     my ($prefix) = @_;
  222.  
  223.     my %keyf = getVarsFromSh("$prefix/etc/sysconfig/keyboard");
  224.     map { keyboard2kmap($_) eq $keyf{KEYTABLE} || $_ eq $keyf{KEYTABLE} ? $_ : (); } keys %keyboards;
  225. }
  226.  
  227.  
  228.  
  229.  
  230. 1;
  231.