usr.sbin/kbdmap/kbdmap.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (c) March 1995 Wolfram Schneider <wosch@FreeBSD.org>. Berlin.
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 # 1. Redistributions of source code must retain the above copyright
  10 #    notice, this list of conditions and the following disclaimer.
  11 # 2. Redistributions in binary form must reproduce the above copyright
  12 #    notice, this list of conditions and the following disclaimer in the
  13 #    documentation and/or other materials provided with the distribution.
  14 #
  15 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  16 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18 # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  19 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  21 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  22 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  23 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  24 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  25 # SUCH DAMAGE.
  26 #
  27 # kbdmap/vidfont - front end for syscons
  28 #
  29 # $Id: kbdmap.pl,v 1.6 1997/02/22 16:06:02 peter Exp $
  30
  31
  32 # simple test if syscons works
  33 $x11 = system("kbdcontrol -d >/dev/null");
  34 if ($x11) {
  35     warn "You are not on a virtual console - " .
  36         "expect certain strange side-effects\n";
  37     sleep 2;
  38 }
  39
  40 sub variables_static {
  41     $lang_default = "en";       # set default language
  42     $lang = $ENV{'LC_CTYPE'} || $ENV{'LANG'} || $lang_default;
  43     $lang = &lang($lang);
  44     $program = $0; $program =~ s|.*/||; $program =~ s/\.(pl|perl)$//;
  45     $keymapdir = "/usr/share/syscons/keymaps";
  46     $fontdir = "/usr/share/syscons/fonts";
  47     $sysconfig = "/etc/rc.conf";
  48
  49     # for test only
  50     #$keymapdir = "/tmp/kbdmap/syscons/keymaps";
  51     #$fontdir = "/tmp/kbdmap/syscons/fonts";
  52
  53     # read current font from rc.conf
  54     $font_default = "cp437-8x16.fnt";
  55     $font_current = &font_current($font_default);
  56
  57     if ($program eq "kbdmap") {
  58         $dir = $keymapdir;
  59     } else {
  60         $dir = $fontdir;
  61     }
  62
  63     @langsupport = ('MENU', 'FONT'); # lang depended variables
  64     $show = 0;                  # show which languages currently supported
  65     $index = "INDEX";           # Keyboard language database
  66     $verbose = 0;
  67     %keymap = '';
  68 }
  69
  70 sub lang {
  71     local($lang) = @_;
  72
  73     #$lang =~ s/_.*//;          # strip country and font
  74     $lang =~ s/^(C)$/en/;       # aliases
  75     #$lang =~ s/^(..).*/$1/;    # use only first to characters
  76
  77     return $lang;
  78 }
  79
  80 sub font_current {
  81     local($font) = @_;
  82     local($font_current);
  83
  84     open(F, "$sysconfig") || warn "$sysconfig: $!\n";
  85
  86     while(<F>) {
  87         /^#/ && next;
  88         if (/^\s*font[0-9]+x[0-9]+\s*=\s*(\S+)/) {
  89             $font_current = $1 if $1 ne "NO";
  90         }
  91     }
  92     close F;
  93
  94     return $font_current if $font_current;
  95     return $font;
  96 }
  97
  98 sub vidcontrol {
  99     local($font) = @_;
 100
 101     return $x11 if $x11;        # syscons test failed
 102
 103     if ($font =~ /.*([0-9]+x[0-9]+)(\.fnt)?$/) {
 104         warn "vidcontrol -f $1 $font\n" if $verbose;
 105         return system("vidcontrol -f $1 $font");
 106     } else {
 107         warn "Which font size? ``$font''\n";
 108         return 1;
 109     }
 110 }
 111
 112 sub menu_read {
 113     local($e,@a,$mark,$ext);
 114     local($keym, $lg, $dialect, $desc);
 115     local(@langlist) = $lang_default;
 116
 117     $ext = $dir; $ext =~ s|.*/||;
 118     # en_US.ISO8859-1 -> en_..\.ISO8859-1
 119     ($dialect = $lang) =~ s/^(..)_..(.+)$/$1_..$2/;
 120     # en_US.ISO8859-1 -> en
 121     ($lang_abk = $lang) =~ s/^(..)_.*$/$1/;
 122
 123     # read index database
 124     open(I, "$dir/$index.$ext") || warn "$dir/$index.$ext: $!\n";
 125     while(<I>) {
 126         # skip blank lines and comments
 127         /^#/ && next;
 128         s/^\s+//;
 129         /^\w/ || next;
 130         s/\s+$//;
 131
 132         ($keym, $lg, $desc) = split(/:/);
 133         if (! -r "$keym" && ! -r "$dir/$keym" &&
 134             !grep(/$keym/, @langsupport)) {
 135             warn "$keym not found!\n" if $verbose;
 136             next;
 137         }
 138
 139         # set empty language to default language
 140         $lg = $lang_default if $lg eq "";
 141
 142         # save language
 143         if ($show) {
 144             foreach $e (split(/,/, $lg)) {
 145                 push(@langlist, $e) if !grep($_ eq $e, @langlist);
 146             }
 147         }
 148
 149         # 4) your choise if exist
 150         # 3) long match e.g. en_GB.ISO8859-1 is equal to en_..\.ISO8859-1
 151         # 2) short match 'de'
 152         # 1) default langlist 'en'
 153         # 0) any language
 154         #
 155         # language may be a kommalist
 156         # higher match overwrite lower
 157         # last entry overwrite previous if exist twice in database
 158
 159         # found your favorite language :-)
 160         if ($lg =~  /^(.+,)?$lang(,.+)?$/) {
 161             $keymap{$keym} = $desc;
 162             $mark{$keym} = 4;
 163         } elsif ($mark{$keym} <= 3 && $lg =~  /^(.+,)?$dialect(,.+)?$/) {
 164             # dialect
 165             $keymap{$keym} = $desc;
 166             $mark{$keym} = 3;
 167         } elsif ($mark{$keym} <= 2 && $lg =~  /^(.+,)?$lang_abk(,.+)?$/) {
 168             # abrevation
 169             $keymap{$keym} = $desc;
 170             $mark{$keym} = 2;
 171         } elsif ($mark{$keym} <= 1 && $lg =~  /^(.+,)?$lang_default(,.+)?$/) {
 172             # default
 173             $keymap{$keym} = $desc;
 174             $mark{$keym} = 1;
 175         } elsif ($mark{$keym} <= 0) {
 176             # any
 177             $keymap{$keym} = $desc;
 178             $mark{$keym} = 0;
 179         }
 180     }
 181     close I;
 182
 183     if ($show) {
 184         @langlist = sort(@langlist);
 185         print "Currently supported languages: @langlist\n";
 186         exit(0);
 187     }
 188
 189     # remove variables from list
 190     local($ee);
 191     foreach $e (@langsupport) {
 192         ($ee = $e) =~ y/A-Z/a-z/;
 193         eval "\$$ee = \"$keymap{$e}\"";
 194         #warn "$e \$$ee = \"$keymap{$e}\"";
 195         delete $keymap{$e};
 196     }
 197     #warn "$font $font_default $font_current\n";
 198
 199
 200     # look for keymaps which are not in database
 201     opendir(D, "$dir") || warn "$dir: $!\n";
 202     foreach $e (readdir(D)) {
 203         if ($e =~ /^[a-z].*(kbd|fnt)$/ && !$keymap{$e}) {
 204             warn "$e not in database\n" if $verbose;
 205             $keymap{$e} = $e;
 206             $keymap{$e} =~ s/\.(kbd|fnt)$//;
 207         }
 208     }
 209     closedir D;
 210
 211     # sort menu, font 8x8 is less than 8x14 and 8x16
 212     foreach $e (sort(keys %keymap)) {
 213         push(@a, "\"$keymap{$e}\" \"\"");
 214     }
 215     # side effects to @a
 216     grep(s/8x8/8x08/, @a);
 217     @a = sort @a;
 218     grep(s/8x08/8x8/, @a);
 219
 220     if ($print) {
 221         foreach (@a) {
 222             s/"//g; #"
 223             print "$_\n";
 224         }
 225         exit;
 226     }
 227
 228     return @a;
 229 }
 230
 231 sub dialog {
 232     local(@argv) = @_;
 233     local($tmp) = "/tmp/_kbd_lang$$";
 234
 235     $dialog = "/usr/bin/dialog \\
 236 --clear \\
 237 --title \"Keyboard Menu\" \\
 238 --menu \"$menu\" \\
 239 -1 -1 10";
 240
 241     ## *always* start right font, don't believe that your current font
 242     ## is equal with default font in /etc/rc.conf
 243     ## see also at end of this function
 244     ## if ($font) {
 245
 246     # start right font, assume that current font is equal
 247     # to default font in /etc/rc.conf
 248     #
 249     # $font is the font which require the language $lang; e.g.
 250     # russian *need* a koi8 font
 251     # $font_current is the current font from /etc/rc.conf
 252     if ($font && $font ne $font_current) {
 253         &vidcontrol($font);
 254     }
 255
 256     # start dialog
 257     system("$dialog @argv 2> $tmp");
 258
 259     if (!$?) {
 260         $choise = `cat $tmp`;
 261         foreach $e (keys %keymap) {
 262             if ($keymap{$e} eq $choise) {
 263                 if ($program eq "kbdmap") {
 264                     system("kbdcontrol -l $dir/$e\n") unless $x11;
 265                     print "keymap=$e", "\n";
 266                 } else {
 267                     &vidcontrol("$dir/$e");
 268                     $_ = $e;
 269                     if (/^.*\-(.*)\.fnt/) {
 270                         $font=$1
 271                     } else { $font="unknown" }
 272                     print "font$font=$e", "\n";
 273                 }
 274                 last;
 275             }
 276         }
 277     # } else {
 278     } elsif ($font && $font ne $font_current) {
 279         # cancel, restore old font
 280         &vidcontrol($font_current);
 281     }
 282     unlink $tmp;
 283     exit($?);
 284 }
 285
 286 sub usage {
 287     warn <<EOF;
 288 usage: $program\t[-K] [-V] [-d|-default] [-h|-help] [-l|-lang language]
 289 \t\t[-p|-print] [-r|-restore] [-s|-show] [-v|-verbose]
 290 EOF
 291     exit 1;
 292 }
 293
 294 # Argumente lesen
 295 sub parse {
 296     local(@argv) = @_;
 297
 298     while($_ = $argv[0], /^-/) {
 299         shift @argv;
 300         last if /^--$/;
 301         if (/^--?(h|help|\?)$/)  { &usage; }
 302         elsif (/^-(v|verbose)$/) { $verbose = 1; }
 303         elsif (/^-(l|lang)$/)    { $lang = &lang($argv[0]); shift @argv; }
 304         elsif (/^-(d|default)$/) { $lang = $lang_default }
 305         elsif (/^-(s|show)$/)    { $show = 1 }
 306         elsif (/^-(p|print)$/)   { $print = 1 }
 307         elsif (/^-(r|restore)$/) { &vidcontrol($font_current); exit(0) }
 308         elsif (/^-K$/)           { $dir = $keymapdir; }
 309         elsif (/^-V$/)           { $dir = $fontdir; }
 310         else                     { &usage }
 311     }
 312 }
 313
 314 # main
 315 &variables_static;              # read variables
 316 &parse(@ARGV);                  # parse arguments
 317 &dialog(&menu_read);            # start dialog and kbdcontrol/vidcontrol