This commit was manufactured by cvs2svn to create branch

'MDK-10-update'.

1 files changed, 165 insertions, 0 deletions

diff --git a/perl-install/Xconfig/xfree4.pm b/perl-install/Xconfig/xfree4.pm
new file mode 100644
index 000000000..5c2d23286
--- /dev/null
+++ b/perl-install/Xconfig/xfree4.pm
@@ -0,0 +1,165 @@
+package Xconfig::xfree4; # $Id$
+
+use diagnostics;
+use strict;
+
+use common;
+use Xconfig::parse;
+use Xconfig::xfree;
+
+our @ISA = 'Xconfig::xfreeX';
+
+sub name { 'xfree4' }
+sub config_file { '/etc/X11/XF86Config-4' }
+
+
+sub get_keyboard_section {
+    my ($raw_X) = @_;
+    my ($raw_kbd) = get_InputDevices($raw_X, 'Keyboard') or die "no keyboard section";
+    $raw_kbd;
+}
+
+sub new_keyboard_section {
+    my ($raw_X) = @_;
+    my $raw_kbd = { Identifier => { val => 'Keyboard1' }, Driver => { val => 'Keyboard' } };
+    $raw_X->add_Section('InputDevice', $raw_kbd);
+
+    my $layout = get_ServerLayout($raw_X)->{InputDevice} ||= [];
+    push @$layout, { val => '"Keyboard1" "CoreKeyboard"' };
+
+    $raw_kbd;
+}
+
+sub get_mouse_sections {
+    my ($raw_X) = @_;
+    get_InputDevices($raw_X, 'mouse');
+}
+sub new_mouse_sections {
+    my ($raw_X, $nb_new) = @_;
+    $raw_X->remove_InputDevices('mouse');
+
+    my $layout = get_ServerLayout($raw_X)->{InputDevice} ||= [];
+    @$layout = grep { $_->{val} !~ /^"Mouse/ } @$layout;
+
+    $nb_new or return;
+
+    my @l = map {
+	my $h = { Identifier => { val => "Mouse$_" }, Driver => { val => 'mouse' } };
+	$raw_X->add_Section('InputDevice', $h);
+    } (1 .. $nb_new);
+
+    push @$layout, { val => qq("Mouse1" "CorePointer") };
+    push @$layout, { val => qq("Mouse$_" "SendCoreEvents") } foreach 2 .. $nb_new;
+
+    @l;
+}
+
+sub set_wacoms {
+    my ($raw_X, @wacoms) = @_;
+    $raw_X->remove_InputDevices('wacom');
+
+    my $layout = get_ServerLayout($raw_X)->{InputDevice} ||= [];
+    @$layout = grep { $_->{val} !~ /^"(Stylus|Eraser|Cursor)/ } @$layout;
+
+    @wacoms or return;
+
+    my %Modes = (Stylus => 'Absolute', Eraser => 'Absolute', Cursor => 'Relative');
+
+    each_index {
+	my $wacom = $_;
+	foreach (keys %Modes) {
+	    my $identifier = $_ . ($::i + 1);
+	    my $h = { Identifier => { val => $identifier }, 
+		      Driver => { val => 'wacom' },
+		      Type => { val => lc $_, Option => 1 },
+		      Device => { val => $wacom->{Device}, Option => 1 },
+		      Mode => { val => $Modes{$_}, Option => 1 },
+		      if_($wacom->{USB}, USB => { Option => 1 })
+		    };
+	    $raw_X->add_Section('InputDevice', $h);
+	    push @$layout, { val => qq("$identifier" "AlwaysCore") };
+	}
+    } @wacoms;
+}
+
+sub depths { 8, 15, 16, 24 }
+sub set_resolution {
+    my ($raw_X, $resolution, $o_Screen_) = @_;
+    
+    foreach my $Screen ($o_Screen_ ? $o_Screen_ : $raw_X->get_screens) {
+	$Screen ||= $raw_X->get_default_screen or internal_error('no screen');
+
+	$Screen->{DefaultColorDepth} = { val => $resolution->{Depth} eq '32' ? 24 : $resolution->{Depth} };
+	$Screen->{Display} = [ map {
+	    { l => { Depth => { val => $_ }, Virtual => { val => join(' ', @$resolution{'X', 'Y'}) } } };
+	} $raw_X->depths ];
+    }
+}
+
+sub get_device_section_fields {
+    qw(VendorName BoardName Driver VideoRam Screen BusID); #-);
+}
+
+sub new_device_sections {
+    my ($raw_X, $nb_new) = @_;
+    my @l = $raw_X->SUPER::new_device_sections($nb_new);
+    $_->{DPMS} = { Option => 1 } foreach @l;
+    @l;
+}
+
+sub new_screen_sections {
+    my ($raw_X, $nb_new) = @_;
+    my @l = $raw_X->SUPER::new_screen_sections($nb_new);
+    each_index { $_->{Identifier} = { val => "screen" . ($::i+1) } } @l;
+
+    get_ServerLayout($raw_X)->{Screen} = [ 
+	{ val => qq("screen1") }, #-)
+	map { { val => sprintf('"screen%d" RightOf "screen%d"', $_, $_ - 1) } } (2 .. $nb_new)
+    ];
+
+    @l;
+}
+
+sub is_fbdev {
+    my ($raw_X, $Screen) = @_;
+
+    my $Screen_ = $Screen || $raw_X->get_default_screen or return;
+
+    my $Device = $raw_X->get_Section_by_Identifier('Device', val($Screen_->{Device})) or internal_error("no device named $Screen_->{Device}");
+    val($Device->{Driver}) eq 'fbdev';
+}
+
+sub set_Option {
+    my ($_raw_X, $category, $node, @names) = @_;
+    
+    if (member($category, 'keyboard', 'mouse')) {
+	#- everything we export is an Option
+	$_->{Option} = 1 foreach map { deref_array($node->{$_}) } @names;
+    }
+}
+
+
+#-##############################################################################
+#- helpers
+#-##############################################################################
+sub get_InputDevices {
+    my ($raw_X, $Driver) = @_;
+    $raw_X->get_Sections('InputDevice', sub { val($_[0]{Driver}) eq $Driver });
+}
+sub remove_InputDevices {    
+    my ($raw_X, $Driver) = @_;
+    $raw_X->remove_Section('InputDevice', sub { val($_[0]{Driver}) ne $Driver });
+}
+
+sub get_ServerLayout {
+    my ($raw_X) = @_;
+    $raw_X->get_Section('ServerLayout') ||
+      $raw_X->add_Section('ServerLayout', { Identifier => { val => 'layout1' } });
+}
+
+sub val {
+    my ($ref) = @_;
+    $ref && $ref->{val};
+}
+
+1;