#!/usr/bin/perl
#
# Copyright (c) March 1995 Wolfram Schneider <wosch@FreeBSD.org>. Berlin.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# kbdmap/vidfont - front end for syscons
#
# $Id: kbdmap.pl,v 1.7 1997/05/19 07:30:45 jkh Exp $
# simple test if syscons works
$x11 = system("kbdcontrol -d >/dev/null");
if ($x11) {
warn "You are not on a virtual console - " .
"expect certain strange side-effects\n";
sleep 2;
}
sub variables_static {
$lang_default = "en"; # set default language
$lang = $ENV{'LC_CTYPE'} || $ENV{'LANG'} || $lang_default;
$lang = &lang($lang);
$program = $0; $program =~ s|.*/||; $program =~ s/\.(pl|perl)$//;
$keymapdir = "/usr/share/syscons/keymaps";
$fontdir = "/usr/share/syscons/fonts";
$sysconfig = "/etc/rc.conf";
# for test only
#$keymapdir = "/tmp/kbdmap/syscons/keymaps";
#$fontdir = "/tmp/kbdmap/syscons/fonts";
# read current font from rc.conf
$font_default = "cp437-8x16.fnt";
$font_current = &font_current($font_default);
if ($program eq "kbdmap") {
$dir = $keymapdir;
} else {
$dir = $fontdir;
}
@langsupport = ('MENU', 'FONT'); # lang depended variables
$show = 0; # show which languages currently supported
$index = "INDEX"; # Keyboard language database
$verbose = 0;
%keymap = '';
}
sub lang {
local($lang) = @_;
#$lang =~ s/_.*//; # strip country and font
$lang =~ s/^(C)$/en/; # aliases
#$lang =~ s/^(..).*/$1/; # use only first to characters
return $lang;
}
sub font_current {
local($font) = @_;
local($font_current);
open(F, "$sysconfig") || warn "$sysconfig: $!\n";
while(<F>) {
/^#/ && next;
if (/^\s*font[0-9]+x[0-9]+\s*=\s*(\S+)/) {
$font_current = $1 if $1 ne "NO";
}
}
close F;
return $font_current if $font_current;
return $font;
}
sub vidcontrol {
local($font) = @_;
return $x11 if $x11; # syscons test failed
if ($font =~ /.*([0-9]+x[0-9]+)(\.fnt)?$/) {
warn "vidcontrol -f $1 $font\n" if $verbose;
return system("vidcontrol -f $1 $font");
} else {
warn "Which font size? ``$font''\n";
return 1;
}
}
sub menu_read {
local($e,@a,$mark,$ext);
local($keym, $lg, $dialect, $desc);
local(@langlist) = $lang_default;
$ext = $dir; $ext =~ s|.*/||;
# en_US.ISO8859-1 -> en_..\.ISO8859-1
($dialect = $lang) =~ s/^(..)_..(.+)$/$1_..$2/;
# en_US.ISO8859-1 -> en
($lang_abk = $lang) =~ s/^(..)_.*$/$1/;
# read index database
open(I, "$dir/$index.$ext") || warn "$dir/$index.$ext: $!\n";
while(<I>) {
# skip blank lines and comments
/^#/ && next;
s/^\s+//;
/^\w/ || next;
s/\s+$//;
($keym, $lg, $desc) = split(/:/);
if (! -r "$keym" && ! -r "$dir/$keym" &&
!grep(/$keym/, @langsupport)) {
warn "$keym not found!\n" if $verbose;
next;
}
# set empty language to default language
$lg = $lang_default if $lg eq "";
# save language
if ($show) {
foreach $e (split(/,/, $lg)) {
push(@langlist, $e) if !grep($_ eq $e, @langlist);
}
}
# 4) your choise if exist
# 3) long match e.g. en_GB.ISO8859-1 is equal to en_..\.ISO8859-1
# 2) short match 'de'
# 1) default langlist 'en'
# 0) any language
#
# language may be a kommalist
# higher match overwrite lower
# last entry overwrite previous if exist twice in database
# found your favorite language :-)
if ($lg =~ /^(.+,)?$lang(,.+)?$/) {
$keymap{$keym} = $desc;
$mark{$keym} = 4;
} elsif ($mark{$keym} <= 3 && $lg =~ /^(.+,)?$dialect(,.+)?$/) {
# dialect
$keymap{$keym} = $desc;
$mark{$keym} = 3;
} elsif ($mark{$keym} <= 2 && $lg =~ /^(.+,)?$lang_abk(,.+)?$/) {
# abrevation
$keymap{$keym} = $desc;
$mark{$keym} = 2;
} elsif ($mark{$keym} <= 1 && $lg =~ /^(.+,)?$lang_default(,.+)?$/) {
# default
$keymap{$keym} = $desc;
$mark{$keym} = 1;
} elsif ($mark{$keym} <= 0) {
# any
$keymap{$keym} = $desc;
$mark{$keym} = 0;
}
}
close I;
if ($show) {
@langlist = sort(@langlist);
print "Currently supported languages: @langlist\n";
exit(0);
}
# remove variables from list
local($ee);
foreach $e (@langsupport) {
($ee = $e) =~ y/A-Z/a-z/;
eval "\$$ee = \"$keymap{$e}\"";
#warn "$e \$$ee = \"$keymap{$e}\"";
delete $keymap{$e};
}
#warn "$font $font_default $font_current\n";
# look for keymaps which are not in database
opendir(D, "$dir") || warn "$dir: $!\n";
foreach $e (readdir(D)) {
if ($e =~ /^[a-z].*(kbd|fnt)$/ && !$keymap{$e}) {
warn "$e not in database\n" if $verbose;
$keymap{$e} = $e;
$keymap{$e} =~ s/\.(kbd|fnt)$//;
}
}
closedir D;
# sort menu, font 8x8 is less than 8x14 and 8x16
foreach $e (sort(keys %keymap)) {
push(@a, "\"$keymap{$e}\" \"\"");
}
# side effects to @a
grep(s/8x8/8x08/, @a);
@a = sort @a;
grep(s/8x08/8x8/, @a);
if ($print) {
foreach (@a) {
s/"//g; #"
print "$_\n";
}
exit;
}
return @a;
}
sub dialog {
srand;
local(@argv) = @_;
local($tmp) = "/tmp/_kbd_lang" . rand(9999);
$dialog = "/usr/bin/dialog \\
--clear \\
--title \"Keyboard Menu\" \\
--menu \"$menu\" \\
-1 -1 10";
## *always* start right font, don't believe that your current font
## is equal with default font in /etc/rc.conf
## see also at end of this function
## if ($font) {
# start right font, assume that current font is equal
# to default font in /etc/rc.conf
#
# $font is the font which require the language $lang; e.g.
# russian *need* a koi8 font
# $font_current is the current font from /etc/rc.conf
if ($font && $font ne $font_current) {
&vidcontrol($font);
}
# start dialog
system("$dialog @argv 2> $tmp");
if (!$?) {
$choise = `cat $tmp`;
foreach $e (keys %keymap) {
if ($keymap{$e} eq $choise) {
if ($program eq "kbdmap") {
system("kbdcontrol -l $dir/$e\n") unless $x11;
print "keymap=$e", "\n";
} else {
&vidcontrol("$dir/$e");
$_ = $e;
if (/^.*\-(.*)\.fnt/) {
$font=$1
} else { $font="unknown" }
print "font$font=$e", "\n";
}
last;
}
}
# } else {
} elsif ($font && $font ne $font_current) {
# cancel, restore old font
&vidcontrol($font_current);
}
unlink $tmp;
exit($?);
}
sub usage {
warn <<EOF;
usage: $program\t[-K] [-V] [-d|-default] [-h|-help] [-l|-lang language]
\t\t[-p|-print] [-r|-restore] [-s|-show] [-v|-verbose]
EOF
exit 1;
}
# Argumente lesen
sub parse {
local(@argv) = @_;
while($_ = $argv[0], /^-/) {
shift @argv;
last if /^--$/;
if (/^--?(h|help|\?)$/) { &usage; }
elsif (/^-(v|verbose)$/) { $verbose = 1; }
elsif (/^-(l|lang)$/) { $lang = &lang($argv[0]); shift @argv; }
elsif (/^-(d|default)$/) { $lang = $lang_default }
elsif (/^-(s|show)$/) { $show = 1 }
elsif (/^-(p|print)$/) { $print = 1 }
elsif (/^-(r|restore)$/) { &vidcontrol($font_current); exit(0) }
elsif (/^-K$/) { $dir = $keymapdir; }
elsif (/^-V$/) { $dir = $fontdir; }
else { &usage }
}
}
# main
&variables_static; # read variables
&parse(@ARGV); # parse arguments
&dialog(&menu_read); # start dialog and kbdcontrol/vidcontrol
