#!/usr/bin/perl -w

use strict;

#
# Package contents
#
$::keymaps = {};

# Any item named 'Standard' will be the default choice among its siblings.
# Any single item ditto.
# If none bears that name, declare a sibling element "default => 'his name'".

# Not perfect: the last package declaring a default will win :}
# Maybe package with no default should depend on package with one ?
# Lintian will have to be smart then !

# Maybe implement ratings instead of 'default' flag ?

#####KEYMAPS#####
# -*- perl -*-

$::keymaps->{pc} =
{
    default => 'qwerty',

    'azerty' =>
    {
	default => 'French',
	'French' =>
	{
	    default => 'Same as X11 (latin 9)',
	    'Same as X11 (latin 9)' => { 'Standard' => 'fr-latin9', },
	    'Apple USB' => { 'Standard' => 'mac-usb-fr', },

	},
	'Belgian' => # needs confirm
	{
	    'Standard' =>
	    {
		'Standard' => 'be2-latin1',
	    },
	    'Wang' => { 'Standard' => 'wangbe', },
	    'Apple USB' => { 'Standard' => 'mac-usb-be', },
	},
    },

    'dvorak' => # needs confirm
    {
	default => 'Unknown',
	'Unknown' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'dvorak',
		'ANSI' => 'ANSI-dvorak',
		'Dvorak German' => 'dvorak-de',
		'Dvorak French' => 'dvorak-fr',
		'Dvorak French Bepo' => 'dvorak-fr-bepo',
		'Dvorak French Bepo (UTF8)' => 'dvorak-fr-bepo-utf8',
		'Dvorak Russian' => 'dvorak-ru',
		'Dvorak United Kingdom' => 'dvorak-uk',
		'With French and Spanish accents' => 'pc-dvorak-latin1',
		'Dvorak Classic' => 'dvorak-classic',
		'Dvorak Lisp machine' => 'dvorak-lisp',
	    },
	    'Left single-handed' => { 'Standard' => 'dvorak-l', },
	    'Right single-handed' => { 'Standard' => 'dvorak-r', },
	    'Apple USB' => { 'Standard' => 'mac-usb-dvorak', },
	},
    },

    'fgGIod' =>
    {
	default => 'Turkish',
	'Turkish' => 
	{
	    'Standard' =>
	    {
		default => 'F Layout',
		'F Layout' => 'trf',
		'F Layout with Unicode' => 'trfu',
	    },
	},
    },

    'qwerty' =>
    {
	default => 'US american',
	'US american' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'us',
		'With latin1' => 'us-latin1',
		'US International (ISO 8859-1)' => 'us-intl.iso01',
		'US International (ISO 8859-15)' => 'us-intl.iso15',
		'Lisp Machine' => 'lisp-us',
	    },
	    'Apple USB' =>
	    {
		'Standard' => 'mac-usb-us',
	    },
	},
	'British' =>
	{
	    'Standard' => { 'Standard' => 'uk', },
	    'Apple USB' => { 'Standard' => 'mac-usb-uk', },
	},
	'Bulgarian' =>
	{
	    'Standard' => { 'Standard' => 'bg', },
	    'CP 1251 coding' => { 'Standard' => 'bg-cp1251' },
	},
	'Byelorussian' =>
	{ 
	    'Standard' => { 'Standard' => 'by' },
	},
	'Brazilian' =>	    
	{
	    'BR-Latin1' => { 'Standard' => 'br-latin1', },
	    'Standard' => 
	    { 
		default => 'Standard ABNT2',
		'Standard ABNT2' => 'br-abnt2', 
	    },
	},
	'Canadian' => 
	{
	    default => 'ca-multi',
	    'Multilingual' => { 'Standard' => 'ca-multi', },
	    'French' => { 'Standard' => 'cf', },
	    'English' => { 'Standard' => 'us', },
	},
	'Czech' => # needs confirm
	{
	    'Standard' =>
	    {
		'Standard' => 'cz-lat2',
		'Programmer' => 'cz-lat2-prog',
		'US Layout' => 'cz-us-qwerty',
	    },
	},
	'Danish' => # needs confirm
	{
	    'Standard' =>
	    {
		'Standard' => 'dk',
		'Dead keys' => 'dk-latin1',
		'Apple USB' => 'mac-usb-dk-latin1',
	    },
	},
	'Spanish' => # needs confirm
	{
	    'Standard' =>
	    {
		'Standard' => 'es',
		'CP850' => 'es-cp850',
	    },
	    'Apple USB' =>
	    {
		'Standard' => 'mac-usb-es',
	    },
	},
	'Estonian' => # needs confirm
	{
	    'Standard' =>
	    {
		'Standard' => 'et',
		'No dead keys' => 'et-nodeadkeys',
	    },
	},
	'Finnish' => # needs confirm (cf swedish ?)
	{
	    'Standard' => { 'Standard' => 'fi-latin1', },
	    'Old (obsolete)' => { 'Standard' => 'fi', },
	    'Apple USB' => { 'Standard' => 'mac-usb-fi-latin1', },
	},
	'Polish' => 
	{
	    'Standard' =>
	    {
		default => 'Diacritics with AltGr and Alt',
		'AltGr only diacritics' => 'pl1',
		'Diacritics with AltGr and Alt' => 'pl',
	    },
	},
	'Greek' => 
	{
	    'Standard' =>
	    {
		'Standard' => 'gr',
		'gr-pc' => 'gr-pc',
	    },
	},
	'Italian' => 
	{
	    'Standard' =>
	    {
		'Standard' => 'it',
		'it2' => 'it2',
		'IBM' => 'it-ibm',
	    },
	},
	'Lithuanian' =>
	{
	    'Standard' =>
	    {
		default => 'latin4',	    
		'latin4' => 'lt.l4',
		'unicode' => 'lt',
	    },
	},
	'Latvian' =>
	{
	    'Standard' =>
	    {
		default => 'latin4',
		'latin4' => 'lv-latin4',
		'latin7' => 'lv-latin7',
	    },
	},
	'Norwegian' => # needs confirm
	{
	    'Standard' =>
	    {
		'Standard' => 'no',
		'latin1' => 'no-latin1',
	    },
	},
	'Japanese' => # needs confirm
	{
	    'Standard' => { 'Standard' => 'jp106', },
	    'PC 110' => { 'Standard' => 'pc110', },
	},
	'Dutch' =>
	{
	    'Standard' => { 'Standard' => 'nl', },
	},
	'Hebrew' => 
	{
	    'Standard' => 
	    {
		'Standard' =>  'il',
		'Phonetic' =>   'il-phonetic',
		'il-Heb'   => 'il-heb',
		'Old Phonetic'   => 'hebrew',
	    },
	},
	'Hungarian' =>
	{
	    'Standard' => { 'Standard' => 'hu101', },
	},
	'Icelandic' =>
	{
	    'Standard' => { 'Standard' => 'is-latin1', 
	                    'US' => 'is-latin1-us' 
			  },
	},
	'Kirghiz' =>
	{
	    'Standard' => 
	    { 
		default => 'unicode',
		'unicode' => 'kg', 
	    },
	},
	'Latin American' =>
	{
	    'Standard' => { 'Standard' => 'la-latin1', },
	},
	'Macedonian' =>
	{
	    'Standard' => 
	    { 
		default => 'unicode',
		'unicode' => 'mk', 
	    },
	},
	'Portugese' => 
	{
	    'Standard' =>
	    {
		'Standard' => 'pt-latin1',
		'Old keymap' => 'pt-old',
	    },
	},
	'Romanian' =>
	{
	    'Standard' => 
	    {
		'Standard' => 'ro',
		'Academic' => 'ro-academic',
		'With comma' => 'ro-comma',
	    },
	},
	'Russian' =>
	{

	    'Standard' =>
	    {
		default => 	'KOI8-R (RightAlt)',
		'KOI8-R (RightAlt)' => 'ru1',
		'KOI8-R (RightCtrl)' => 'ru',
		'KOI8-R (102 Keys)' => 'ru3',
		'KOI8-R (105 Keys)' => 'ru4',
		'KOI8-R (MS Cyrillic Layout)' => 'ru-ms',
		'KOI8-R (Yawerty Layout)' => 'ru-yawerty',
		'CP-1251 (1)' => 'ru-cp1251',
		'CP-1251 (2)' => 'ru_win',
		'CP-866' => 'ru2',
	    },
	},
	'Serbian' =>
	{
	    'Standard' => {'Standard' => 'sr', },
	},    
	'Swedish' => # needs confirm (cf finnish ?)
	{
	    'Standard' => { 'Standard' => 'se-latin1', },
	    'Apple USB' => { 'Standard' => 'mac-usb-se', },
	},
	'Slovak' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'sk-qwerty',
		'Programmer' => 'sk-prog',
		'Alternate programmer' => 'sk-prog-qwerty',
	    },
	},
	'Thai' =>
	{
	    'Standard' => {'Standard' => 'th-tis', },
	},
	'Turkish' => # needs confirm
	{
	    'Standard' =>
	    {
		default => 'Q Layout',
		'Q Layout' => 'trq',
		'Q Layout with Unicode' => 'trqu',
		'Alternate' => 'tralt',
	    },
	},
	'Ukrainian' => 
	{
	    'Standard' =>
	    {
		default => 'Standard (koi8u)' ,
		'Standard (koi8u)' => 'ua',
		'WS' => 'ua-ws',
		'unicode' => 'ua-utf',
		'WS - unicode' => 'ua-utf-ws',
		'Alternate' => 'uaw',
		'Alternate - unicode' => 'uaw_uni',
	    },
	},
    },

    'qwertz' =>
    {
	default => 'German',
	'Swiss' => # needs confirm
	{
	    default => 'German',
	    'French' =>
	    {
		'Standard' => 'fr_CH',
		'latin1' => 'fr_CH-latin1',
		'Apple USB' => 'mac-usb-fr_CH-latin1',
	    },
	    'German' =>
	    {
		'Standard' => 'sg',
		'latin1' => 'sg-latin1',
		'latin1-lk450' => 'sg-latin1-lk450',
		'Apple USB' => 'mac-usb-de_CH',
	    },
	},
	'German' => # needs confirm
	{
	    'Standard' =>
	    {
		default => 'de-latin1',
		'latin1' => 'de-latin1',
		'latin1 - no dead keys' => 'de-latin1-nodeadkeys',
		'Programmer' => 'de',
	    },
	    'Apple USB' =>
	    {
		default => 'latin1',
		'latin1' => 'mac-usb-de-latin1',
		'latin1 - no dead keys' => 'mac-usb-de-latin1-nodeadkeys',
	    },
	},
	'Slovak' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'sk-qwertz',
		'Programmer' => 'sk-prog-qwertz',
	    },
	},
	'Czech' =>
	{
	    'Standard' => { 'Standard' => 'cz-us-qwertz', },
	},
	'Polish' =>
	{
	    'Standard' => { 'Standard' => 'pl-qwertz', },
	},
	'Hungarian' =>
	{
	    'Standard' => { 'Standard' => 'hu', },
	},
	'Slovene' =>
	{
	    'Standard' => { 'Standard' => 'slovene', },
	},
	'Croat' =>
	{
	    'Standard' => { 'Standard' => 'croat', },
	},
	'Serbian' =>
	{
	    'Standard' => { 'Standard' => 'sr', },
	},
    },

};

$::keymaps->{sparc} =
{
    default => 'Type 5',
    'Type 6' =>
    {
	default => 'British',
	'British' =>
	{
	    'Standard' => { 'Standard' => 'sunt6-uk', },
	},
    },
    'Type 5' =>
    {
	default => 'US american',
	'French' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-fr-latin1', },
	},
	'German' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-de-latin1', },
	},
	'Spanish' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-es', },
	},
	'Finnish' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-fi-latin1', },
	},
	'Russian' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-ru', },
	},
	'Turkish' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-trqalt' },
	},
	'British' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-uk', },
	},
	'US american' =>
	{
	    'Standard' => { 'Standard' => 'sunkeymap', },
	},
	'Japanese' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-ja', },
	},
	'Norwegian' =>
	{
	    'Standard' => { 'Standard' => 'sunt5-no', },
	},
    },
    'Type 4' =>
    {
	'Spanish' =>
	{
	    'Standard' => { 'Standard' => 'sunt4-es', },
	},
	'Japanese' =>
	{
	    'Standard' => { 'Standard' => 'sunt4-ja', },
	},
	'Norwegian' =>
	{
	    'Standard' => { 'Standard' => 'sunt4-no-latin1', },
	},
	'Finnish' =>
	{
	    'Standard' => { 'Standard' => 'sunt4-fi-latin1', },
	},
    },
    'dvorak' =>
    {
	'Unknown' =>
	{
	    'Standard' => { 'Standard' => 'sundvorak', },
	},
    },
    'Unknown (Polish)' =>
    {
	'Polish' =>
	{
	    'Standard' => { 'Standard' => 'sun-pl', },
	},
    },
};

$::keymaps->{atari} =
{
    'Unknown' =>
    {
	default => 'US american',
	'German' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'atari-de',
		'With dead keys' => 'atari-de-deadkeys',
		'Emacs-like' => 'atari-de-emacs',
	    },
	},
	'Swedish' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'atari-se',
		'With dead keys' => 'atari-se-deadkeys',
	    },
	},
	'British' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'atari-uk',
		'With dead keys' => 'atari-uk-deadkeys',
	    },
	},
	'US american' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'atari-us',
		'With dead keys' => 'atari-us-deadkeys',
	    },
	},
    },
};

$::keymaps->{amiga} =
{
    'Unknown' =>
    {
	default => 'US american',
	'German' =>
	{
	    'Standard' => { 'Standard' => 'amiga-de', },
	},
	'Spanish' =>
	{
	    'Standard' => { 'Standard' => 'amiga-es', },
	},
	'French' =>
	{
	    'Standard' => { 'Standard' => 'amiga-fr', },
	},
	'Italian' =>
	{
	    'Standard' => { 'Standard' => 'amiga-it', },
	},
	'Swedish' =>
	{
	    'Standard' => { 'Standard' => 'amiga-se', },
	},
	'Swiss' =>
	{
	    'German' => { 'Standard' => 'amiga-sg', },
	},
	'US american' =>
	{
	    'Standard' => { 'Standard' => 'amiga-us', },
	},
    },
};

$::keymaps->{mac} =
{
    'Unknown' =>
    {
	default => 'US american',
	'German' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'mac-de2-ext',
		'iBook' => 'mac-ibook-de',
		'iBook with dead keys' => 'mac-ibook-de-deadkeys',
		'MacBook' => 'mac-macbook-de',
		#'No dead keys (broken)' => 'mac-de-latin1-nodeadkeys', # buggy
	    },
	},
	'British' =>
	{
	    'Standard' =>
	    { 
		'Standard' => 'mac-uk',
		'iBook2' => 'ibook2-uk', 
	    },
	},
	'French' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'mac-fr3',
		'New' => 'mac-fr',
		'Extended' => 'mac-fr-ext',
		'MacBook' => 'mac-macbook-fr',
		'Swiss' => 'mac-fr_CH-latin1',
		'Alternate' => 'mac-fr2-ext',
	    },
	},
	'Polish' =>
	{
	    'Standard' => 
	    { 
		'Standard' => 'mac-pl_m-ext',
		# Supply ext1 variant in pkg for ADB freaks; don't offer it here as 
		# ADB is deprecated
	    },
	},
	'Portuguese' => 
	{ 
	    'Standard' =>  { 'Standard' => 'mac-pt-latin1' },
	    'Apple USB' => { 'Standard' => 'mac-usb-pt-latin1' },
	},	    
	'Spanish' => 
	{
	    'Standard' => {  'Standard' => 'mac-es' },
	},
	'Finnish' =>
	{
	    'Standard' => { 'Standard' => 'mac-fi-latin1' },
	},
	'Italian' =>
	{
	    'Standard' =>  
	    { 'Standard' => 'mac-it' , 
	      'iBook' => 'ibook-it',
	      'iBook (alternate)' => 'ibook2-it'
	    },
	    'Apple USB' => { 'Standard' => 'mac-usb-it' },
	},
	'US american' =>
	{
	    'Standard' =>
	    {
		'Standard' => 'mac-us-std',
		'Extended' => 'mac-us-ext',
		'New' => 'mac-us',
		#Dvorak' => 'mac-us-dvorak', # buggy
		'Dvorak' => 'mac-dvorak',
	    },
	},
    },
};

$::obsolete_keymaps = (
		       [ 'pc', 'qwerty', 'Canadadian' ],
		       );

# END OF DATAPACKAGE-SPECIFIC PART
# BELOW THIS LINE IS THE GENERIC PART

# This a preliminary debconf script for console-related data.
# (c) 1999-2000, Yann Dirson <dirson@debian.org>

# It has the following limitations that should be addressed:
# - only handles keymap configuration (ie, only does part of kbdconfig's job)
# - does not allow testing keymap before accepting it (REGRESSION).
# - does not allow reloading a default keymap (REGRESSION).

use Debconf::Client::ConfModule ':all';

die "Syntax error: no argument" if ($#ARGV < 0);

#####COMMON#####
# -*- perl -*-

use vars qw( $obsolete_keymaps );

# Subarches
# FIXME: not done
# Issues:
# * ppc issues not fully asserted yet
# * /proc/hardware, which only exists on m68k and ppc, seems to be
#   an OPTION while configuring the kernel !
#   Any fallback when it's not there ?
# * USB set of keymap should contain what ? mac ? pc ? subset of those ?

# SUBARCH	KEYMAP SET	DETECTION
# m68k/atari	atari		"Model: Atari"
# m68k/amiga	amiga		"Model: Amiga"
# m68k/mac	mac		"Model: Macintosh"
# m68k/mvme	pc		"Model: Motorola"
# m68k/bvme	pc		"Model: BVME[46]000"
# m68k/{sun,apollo,next,q40,hp300} Not supported by Debian

# ppc/apus	amiga		"machine: Amiga"
# ppc/chrp	pc,mac		"machine: CHRP"
# ppc/pmac	mac		"machine: PowerMac|[Pp]ower[Bb]ook*|Power|iMac*|PowerMac1*"
# ppc/prep	pc		"machine: PReP"
# ppc/{bbox,mbx,ppc64,82xx,8xx} Not yet supported by Debian

# arm/*		pc		(refered to as 'arm' only)

sub guess_arch {
  my ($defs) = @_;

  my $arch = `dpkg --print-architecture`;
  chomp $arch;

  # Overrides for testing:
  #     $arch = 'powerpc';
  #     $arch = 'm68k';

  if (($arch eq 'powerpc') || ($arch eq 'm68k')) {
    my $subarch;
    if ($arch eq 'powerpc') {
      my $line = `sed -n 's/^machine.*: //p' /proc/cpuinfo`;
      chomp $line;
      if ($line eq '') { 
	      my $line = `sed -n 's/^platform.*: //p' /proc/cpuinfo`;
	      chomp $line;
              abort ($defs, "No \"machine\" or \"platform\" field in /proc/cpuinfo") if $line eq '';
      }
      $subarch = lc $line;
    } elsif ($arch eq 'm68k') {
      my $line = `sed -n 's/^Model.*://p' /proc/hardware`;
      chomp $line;
      abort ($defs, "No \"Model\" field in /proc/hardware") if $line eq '';
      $subarch = lc $line;
    }
    chomp($subarch);
    $subarch =~ s/^\s*//;
    $subarch = 'amiga'	if $subarch =~ m/amiga/;
    $subarch = 'chrp'	if $subarch =~ m/chrp/;
    $subarch = 'prep'	if $subarch =~ m/prep/;
    $subarch = 'mac'	if $subarch =~ m/macintosh|powermac|powerbook|power|imac|powermac1/;
    $subarch = 'atari'	if $subarch =~ m/atari/;
    $subarch = 'mvme'	if $subarch =~ m/motorola/;
    $subarch = 'bvme'	if $subarch =~ m/bvme/;
    $subarch = 'ps3'	if $subarch =~ m/PS3/;

    $arch = "$arch/$subarch";
  }

  # Overrides for testing:
  #     $arch = 'sparc';
  #     $arch = 'powerpc/mac';
  #     $arch = 'powerpc/chrp';
  #     $arch = 'm68k/amiga';
  #     $arch = 'alpha';

  return $arch;
}

sub abort {
  my ($defs, $msg) = @_;
  print STDERR "Debconf module aborted ($msg) - using old config mechanism.\n";
#  fset_default($defs);
  exit 0;
}

sub correctname($) {
  my ($string) = @_;

  $string = lc $string;
  $string =~ s/[^a-z0-9+\-\.\/]/_/g;

  return $string;
}

# BELOW THIS LINE IS STUFF FOR ALL KEYMAP PROVIDERS

$::keymap_defs = {
		  'prefix' => 'console-data/keymap/',
		  'toplevel' => 'family',
		  'sublevels' => [
				  'layout',
				  'variant',
				  'keymap',
				 ],
		  'allitems' => $::keymaps,
		  'obsolete' => $::obsolete_keymaps,
		  'archsets' => {
				 'i386' => [ 'pc' ],
				 #			       'hurd-i386' => [ 'pc' ],
				 'sparc' => [ 'sparc' ],
				 'alpha' => [ 'pc' ],
				 'arm' => [ 'pc' ],
				 'arm/riscpc' => [ 'pc' ],
				 'mips' => [ 'pc' ],
				 'm68k/atari' => [ 'atari' ],
				 'm68k/amiga' => [ 'amiga' ],
				 'm68k/mac' => [ 'mac' ],
				 'm68k/mvme' => [ 'pc' ],
				 'm68k/bvme' => [ 'pc' ],
				 'powerpc/amiga' => [ 'amiga' ], # apus
				 'powerpc/chrp' => [ 'pc', 'mac' ],
				 'powerpc/mac' => [ 'pc' ],
				 'powerpc/prep' => [ 'pc' ],
				 'powerpc/ps3' => [ 'pc' ],
				 'amd64' => [ 'pc' ],
				},
		 };

# Layout of questions is:
#
# console-data/keymap/
#   /family
#   /azerty/
#     /layout
#     /french/
#       /variant
#       /without euro/
#         /keymap

# FIXME: maybe use eg. country codes in storage, and translate into
# localized string when needed ?

sub declare_keymaps {
  my ($defs) = @_;

  foreach my $kbdarch (@{$defs->{archsets}->{guess_arch($defs)}}) {
    declare_families ($defs, $defs->{allitems}->{$kbdarch}, $defs->{prefix});
  }
}

# Maybe set a default choice if none already set
sub maybe_set_default_choice {
#	my ($question, $default) = @_;
#	(my $ret, my $seen) = fget ($question, 'seen');
#	if ($seen eq 'false') {
#	  my $x = metaget ($question, 'value') ;
#	  print STDERR " $question is #$x# ";
#	}	
#set ($question, $default) if $seen eq 'false';
}

#
# Clear obsolete entries from the database,
# Tidy up this ugly hack somehow
sub clear_cruft {
	my ($version) = @_;
	my $ret = 0;
	my $val = '';
	if ($version eq '') {
		$version='0';
	}
	my $x=system("dpkg --compare-versions $version lt 0.7.25");
	if ($x eq 0 ) {
		unregister ('console-data/keymap/full');
		my ($ret, $val) = metaget ('console-data/keymap/azerty/french/variant', 'value');
		if ($val eq 'With Euro (latin 0)') {
			set ('console-data/keymap/azerty/french/variant','With Euro (latin 9)');
		}
		subst ('console-data/keymap/azerty/french/variant', 'choices',
			'Apple USB, PC keyboard (non-US 102 keys), Same as X11 (latin 1), With Euro (latin 9)');
	}
	# The speakup keymaps were removed from console-data in sarge
	($ret, $val) = get ('console-data/keymap/full');
	set ('console-data/keymap/full', 'us') if ($val eq  "speakup");
	set ('console-data/keymap/full', 'lt') if ($val eq "speakup-lt");
	my $lith_keymap = 'console-data/keymap/qwerty/lithuanian/standard/keymap';
	($ret, $val) = get ($lith_keymap);
	set ($lith_keymap, 'latin4') if ($val eq "Speakup");
	subst ($lith_keymap, 'choices', 'latin4, unicode');
	my $us_keymap = 'console-data/keymap/qwerty/us_american/standard/keymap';
	($ret, $val) = get ($us_keymap);
	set ($us_keymap, 'standard') if ($val eq "Speakup");
	subst ($us_keymap, 'choices', 
		'Standard, US International (ISO 8859-1), US International (ISO 8859-15), With latin1');
}


sub find_default {
  my ($leveldefs, $question) = @_;

  if (defined $leveldefs->{default}) {
    my $def = $leveldefs->{default};
    # FIXME: not really deleted ?!
    delete $leveldefs->{default};
    return $def;
  } elsif (defined $leveldefs->{Standard}) {
    return 'Standard';
#  } elsif (scalar(keys %{$leveldefs}) == 1) {
  } else {
    printf STDERR "No default for $question - picking one\n";
    $::warned = 1;
    return (keys %{$leveldefs})[0];
  }
}

sub declare_families {
  my ($defs, $familydefs, $prefix) = @_;
  my $familyquestion = $prefix . $defs->{toplevel};
  $familyquestion = correctname $familyquestion;

  # There is only one family question, never need to register more

  my ($ret, $families) = metaget ($familyquestion, 'choices');
  my @families = split (/, */, $families);

  # take default entry into account
  my $default = find_default ($familydefs, $familyquestion);

  foreach my $family (keys %{$familydefs}) {
    # add family if not declared yet
    push (@families, $family) unless grep { $_ eq $family } @families;

    declare_layouts ($defs,
		     $familydefs->{$family},
		     $prefix . $family . '/');
  }

  # Update list of available families
  subst ($familyquestion, 'choices', join (", ", sort @families));
  maybe_set_default_choice ($familyquestion, $default);
}

sub declare_layouts {
  my ($defs, $layoutdefs, $prefix) = @_;
  my $layoutquestion = $prefix . $defs->{sublevels}->[0];
  $layoutquestion = correctname $layoutquestion;

  # create if needed
  my ($ret) = get ($layoutquestion);
  register ($defs->{prefix} . 'template/' . $defs->{sublevels}->[0],
	    $layoutquestion) if $ret == 10;

  ($ret, my $layouts) = metaget ($layoutquestion, 'choices');
  my @layouts = split (/, */, $layouts);

  # take default entry into account
  my $default = find_default ($layoutdefs, $layoutquestion);

  foreach my $layout (keys %{$layoutdefs}) {
    # add layout if not declared yet
    push (@layouts, $layout) unless grep { $_ eq $layout } @layouts;

    declare_kbdvariants ($defs,
			 $layoutdefs->{$layout},
			 $prefix . $layout . '/');
  }
  # Update list of available layouts
  subst ($layoutquestion, 'choices', join (", ", sort @layouts));
  # Maybe set default choice
  maybe_set_default_choice ($layoutquestion, $default);
}

sub declare_kbdvariants {
  my ($defs, $kbdvariantdefs, $prefix) = @_;
  my $kbdvariantquestion = $prefix . $defs->{sublevels}->[1];
  $kbdvariantquestion = correctname $kbdvariantquestion;

  # create if needed
  my ($ret) = get ($kbdvariantquestion);
  register ($defs->{prefix} . 'template/' . $defs->{sublevels}->[1],
	    $kbdvariantquestion) if $ret == 10;

  ($ret, my $kbdvariants) = metaget ($kbdvariantquestion, 'choices');
  my @kbdvariants = split (/, */, $kbdvariants);

  # take default entry into account
  my $default = find_default ($kbdvariantdefs, $kbdvariantquestion);

  foreach my $kbdvariant (keys %{$kbdvariantdefs}) {
    # add kbdvariant if not declared yet
    push (@kbdvariants, $kbdvariant) unless grep { $_ eq $kbdvariant } @kbdvariants;

    declare_mapvariants ($defs,
			 $kbdvariantdefs->{$kbdvariant},
			 $prefix . $kbdvariant . '/');
  }
  # Update list of available kbdvariants
  subst ($kbdvariantquestion, 'choices', join (", ", sort @kbdvariants));
  # Maybe set default choice
  maybe_set_default_choice ($kbdvariantquestion, $default);
}

sub declare_mapvariants {
  my ($defs, $mapvariantdefs, $prefix) = @_;
  my $mapvariantquestion = $prefix . $defs->{sublevels}->[2];
  $mapvariantquestion = correctname $mapvariantquestion;

  # create if needed
  my ($ret) = get ($mapvariantquestion);
  register ($defs->{prefix} . 'template/' . $defs->{sublevels}->[2],
	    $mapvariantquestion) if $ret == 10;

  # take default entry into account
  my $default = find_default ($mapvariantdefs, $mapvariantquestion);

  ($ret, my $mapvariants) = metaget ($mapvariantquestion, 'choices');
  my @mapvariants = split (/, */, $mapvariants);

  foreach my $mapvariant (keys %{$mapvariantdefs}) {
    # add mapvariant if not declared yet
    push (@mapvariants, $mapvariant) unless grep { $_ eq $mapvariant } @mapvariants;
  }
  # Update list of available mapvariants
  subst ($mapvariantquestion, 'choices', join (", ", sort @mapvariants));
  maybe_set_default_choice ($mapvariantquestion, $default);
}

# handle transitions in the state machine
sub transition {
  my ($defs, $origstate, $priority, $prev, $next) = @_;
  my $newstate;
  my $ret;
  my @retval;

  # compute question according to state
  my $prefix = $defs->{prefix};
  my $question = $prefix . $defs->{toplevel};
  for (my $level = 0; $level < $origstate; $level ++) {
    my ($ret, $choice) = get ($question);
    $prefix = $prefix . $choice . '/';
    $question = $prefix . $defs->{sublevels}->[$level];
    $question = correctname $question;
  }

  ($ret) = input ($priority, $question);
  @retval = go;
  if ($retval[0] eq 30) {
      $newstate = $prev;
  } else {
    $newstate = $next;
  }

  return $newstate;
}


# The real config engine
sub configure {
  my ($defs) = @_;
  my $ret;
  my @retval;

  my $state = 0;
  # This is a simple state machine for all config items
  while ($state != 99) {

    #
    # Change the keymap ?
    #

    ($state == 0) && do {

      # This one has a default, we can trust it has a value
      ($ret) = input ('high', 'console-data/keymap/policy');
      if ($ret == 30) {		# if the question is not going to be asked...
 	maybe_set_default_choice ('console-data/keymap/policy', "Don't touch keymaps");
      }
      @retval = go;
      if ($retval[0] eq 30) {
	set ('console-data/keymap/policy', "Don't touch keymap");
	exit 30; 
      }

      my $policy = get ('console-data/keymap/policy');

      # Ugly workaround for Bug 107700
      $policy = 'Select keymap from arch list' if
          $policy eq "console-data/keymap/policy doesn't exist";

      if ($policy eq 'Select keymap from arch list') {
	$state = 1;
	next;
      } elsif ($policy eq "Don't touch keymap") {
	# if the user has a bootime keymap in an old location, warn
	if (! -r '/etc/console/boottime.kmap.gz'
	    and ( -r '/etc/kbd/default.kmap' or -r '/etc/kbd/default.kmap.gz' or
		  -r '/etc/console-tools/default.kmap' or -r '/etc/console-tools/default.kmap.gz')) {
	  input ('critical', 'console-data/keymap/ignored');
	  @retval = go;
	  if ($retval[0] eq "backup") {
	    ($ret, my $seen) = fget ('console-data/keymap/policy', 'seen');
	    if ($seen eq 'false') {
	      # Hitting "back" here has no meaning mostly, but try to behave as sanely as I
	      # can think of.
	      exit 30;
	    } else {
	      next;
	    }
	  }
	}

	$state = 99;
      } elsif ($policy eq 'Keep kernel keymap') {
	$state = 99;
      } elsif ($policy eq 'Select keymap from full list') {
        my $ret;
        ($ret) = input ('high', 'console-data/keymap/full');
        if ($ret == 30) {
            $state = 99;
            next;
        }
        @retval = go;
        if ($retval[0] eq 'backup') {
           $state = 0;
        } else {
           $state = 99;
           my($full);
           ($ret, $full) = get ('console-data/keymap/full');
           if ($full) {
               set ('console-data/keymap/full', $::all_maps{$full});
           }
        }
      } else {
	die "get(console-data/keymap/policy) said $policy"
      }
    };

    #
    # Keymap changes
    #

    ($state == 1) && do {

	my $kstate = 0;

        if (guess_arch($::keymap_defs) eq 'powerpc/mac') {
            my($proc_file) = "/proc/sys/dev/mac_hid/keyboard_sends_linux_keycodes";
            if (-e $proc_file) {
                open(KEYCODES, $proc_file);
                my($input) = <KEYCODES>;
                chomp($input);
                close(KEYCODES);
                if ($input eq "0") {
                    input ('high', 'console-data/keymap/powerpcadb');
                    @retval = go;
                    if ($retval[0] eq 'backup') {
                        $kstate = -1;
                    } else {
                        my($answer);
                        ($ret, $answer) = get ('console-data/keymap/powerpcadb');
                        if ($answer eq 'no') {
                            set ('console-data/keymap/policy', "Don't touch keymap");
                            exit;
                        }
                    }
                    if ($kstate != -1) {
                        open(KEYCODES,  "> $proc_file") || die "Cannot open $proc_file for writing!\n";
                        print KEYCODES "1";
                        close(KEYCODES);
                    }
                }
            }
        }

	# This is a simple embedded state machine for keymap
	while (($kstate != 99) and ($kstate != -1)) {
	  ($kstate == 0) && do { # get_family
	    $kstate = transition ($defs, 0, 'high', -1, 1);
	    next;
	  };

	  ($kstate == 1) && do { # get_layout
	    $kstate = transition ($defs, 1, 'high', 0, 2);
	    next;
	  };

	  ($kstate == 2) && do { # get_kbdvariant
	    $kstate = transition ($defs, 2, 'medium', 1, 3);
	    next;
	  };

	  ($kstate == 3) && do { # get_mapvariant
	    $kstate = transition ($defs, 3, 'low', 2, 99);
	    next;
	  };
	}

	if ($kstate == -1) {
	  $state = 0;
	} else {
	  $state = 99;
	}

      next;
    };

    #
    # The default font, and SFM fallbacks
    #

    #
    # The default ACM ?
    #
  }
}

sub deconfigure {
  my ($defs) = @_;

  # FIXME: should deregister our entries' choices

#  purge;

  # FIXME: should run configuration of console-common afterwards (if needed ?)
}

# GO !

capb ('backup');

# FIXME: this should go in declare_keymaps(), but if I put it there, it
# doesn't seem to work. dunno why
sub walk;
sub walk
{
    my $h = shift;
    my @id = @_;

    for my $k (sort keys %$h)
    {
	next if $k eq 'default';
	if (ref $h->{$k} eq 'HASH')
	{
	    walk $h->{$k}, @id, $k;
	    next;
	}
	my($id) = join(' / ', @id, $k);
	$::all_maps{$id} = $h->{$k};
    }
}


walk $::keymaps;
subst ('console-data/keymap/full', 'choices', join (", ", sort keys %::all_maps));

if ($ARGV[0] eq 'configure') {
  $::warned = 0;
  # do not attempt declaration of empty keymap-list
  declare_keymaps ($::keymap_defs) if %{$::keymaps};
  if ($::warned) {
    printf STDERR <<EOF

If you have information about what choice should be the default for
the above questions which gave warnings, please mail it to
console-data\@packages.debian.org.  Thanks for your help.
EOF
  ;
  }
  # Clear cruft that may be in the database
  clear_cruft ($ARGV[1]);
  # Re-insert, as they've just been deleted... by clear_cruft()
  subst ('console-data/keymap/full', 'choices', join (", ", sort keys %::all_maps));

  # Don't tread on keymaps not installed via install-keymap
  my $hash = 'none';
  my $bootmap = '/etc/console/boottime.kmap.gz';
  $hash = `md5sum $bootmap | cut -f1 -d' '`  if -r $bootmap;
  chomp($hash);
  my ($ret, $val) = get ('console-data/bootmap-md5sum');
  set ('console-data/keymap/policy',"Don't touch keymap") if $val ne $hash;

  configure($::keymap_defs);
}
elsif ($ARGV[0] eq 'reconfigure') {
  configure($::keymap_defs);
}
elsif ($ARGV[0] eq 'X-deconfigure') {
  deconfigure($::keymap_defs);
}