From b2e794d733c54ac59f9e15220746099bd2e7e2fc Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Wed, 24 Jul 2002 22:16:08 +0000 Subject: new XFree handling library - only keyboard and mice functions are done, but adding the others is quite easy - so for now only used in mousedrake - but keyboarddrake and (of course) XFdrake will come --- perl-install/Xconfig/parse.pm | 192 +++++++++++++++++++++++++++++++++++++++++ perl-install/Xconfig/xfree.pm | 76 ++++++++++++++++ perl-install/Xconfig/xfree3.pm | 56 ++++++++++++ perl-install/Xconfig/xfree4.pm | 84 ++++++++++++++++++ perl-install/Xconfig/xfreeX.pm | 142 ++++++++++++++++++++++++++++++ 5 files changed, 550 insertions(+) create mode 100644 perl-install/Xconfig/parse.pm create mode 100644 perl-install/Xconfig/xfree.pm create mode 100644 perl-install/Xconfig/xfree3.pm create mode 100644 perl-install/Xconfig/xfree4.pm create mode 100644 perl-install/Xconfig/xfreeX.pm (limited to 'perl-install/Xconfig') diff --git a/perl-install/Xconfig/parse.pm b/perl-install/Xconfig/parse.pm new file mode 100644 index 000000000..b61651ceb --- /dev/null +++ b/perl-install/Xconfig/parse.pm @@ -0,0 +1,192 @@ +package Xconfig::parse; # $Id$ + +use diagnostics; +use strict; + +use MDK::Common; + + +sub read_XF86Config { + my ($file) = @_; + my $raw_X = raw_from_file($file); + from_raw(@$raw_X); + $raw_X; +} + +sub write_XF86Config { + my ($raw_X, $file) = @_; + my @blocks = map { raw_to_string(before_to_string({ %$_ }, 0)) } @$raw_X; + @blocks ? output($file, @blocks) : unlink $file; +} + +sub read_XF86Config_from_string { + my ($s) = @_; + my $raw_X = raw_from_file('-', [ split "\n", $s ]); + from_raw(@$raw_X); + $raw_X; +} + +#-############################################################################### +#- raw reading/saving +#-############################################################################### +sub raw_from_file { #- internal + my ($file, $lines) = @_; + my $raw_X = []; + + $lines ||= [ cat_($file) ]; + my $line; + my $weird = sub { warn "$file:$line: strange $_[0]" }; + + my ($comment, $obj, @objs); + + my $attach_comment = sub { + $obj || @objs or warn "$file:$line: can't attach comment\n"; + if ($comment) { + $comment =~ s/\n+$/\n/; + ($obj || $objs[0])->{$_[0] . '_comment'} = $comment; + $comment = ''; + } + }; + + foreach (@$lines) { + $line++; + s/^\s*//; s/\s*$//; + + if (/^$/) { + $comment .= "\n" if $comment; + next; + } elsif (/^#\s+(.*)/) { + $comment .= "# $1\n"; + next; + } + + if (/^Section\s+"(.*)"/i) { + die "$file:$line: missing EndSection\n" if @objs; + my $e = { name => $1, l => [], kind => 'Section' }; + push @$raw_X, $e; + unshift @objs, $e; $obj = ''; + $attach_comment->('pre'); + } elsif (/^Subsection\s+"(.*)"/i) { + die "$file:$line: missing EndSubsection\n" if @objs && $objs[0]{kind} eq 'Subsection'; + die "$file:$line: not in Section\n" if !@objs || $objs[0]{kind} ne 'Section'; + my $e = { name => $1, l => [], kind => 'Subsection' }; + push @{$objs[0]{l}}, $e; + unshift @objs, $e; $obj = ''; + $attach_comment->('pre'); + } elsif (/^EndSection/i) { + die "$file:$line: not in Section\n" if !@objs || $objs[0]{kind} ne 'Section'; + $attach_comment->('post'); + shift @objs; $obj = ''; + } elsif (/^EndSubsection/i) { + die "$file:$line: not in Subsection\n" if !@objs || $objs[0]{kind} ne 'Subsection'; + $attach_comment->('post'); + my $e = shift @objs; $obj = ''; + } else { + die "$file:$line: not in Section\n" if !@objs; + + my $commented = s/^#//; + + my $comment_on_line; + s/(\s*#.*)/$comment_on_line = $1; ''/e; + + (my $name, my $Option, $_) = + /^Option\s*"(.*?)"(.*)/ ? ($1, 1, $2) : /^(\S+)(.*)/ ? ($1, 0, $2) : internal_error(); + my ($val) = /(\S.*)/; + + my %e = (Option => $Option, commented => $commented, comment_on_line => $comment_on_line, pre_comment => $comment); + $comment = ''; + $obj = { name => $name, val => $val }; + $e{$_} and $obj->{$_} = $e{$_} foreach keys %e; + + push @{$objs[0]{l}}, $obj; + } + } + $raw_X; +} + +sub raw_to_string { + my ($e, $want_spacing) = @_; + my $s = do { + if ($e->{l}) { + my $inside = join('', map_index { raw_to_string($_, $::i) } @{$e->{l}}); + $inside =~ s/^/ /mg; + qq(\n$e->{kind} "$e->{name}"\n) . $inside . "End$e->{kind}"; + } else { + ($e->{commented} ? '#' : '') . + ($e->{Option} ? qq(Option "$e->{name}") : $e->{name}) . + (defined $e->{val} ? ($e->{Option} && $e->{val} !~ /^"/ ? qq( "$e->{val}") : qq( $e->{val})) : ''); + } + }; + ($e->{pre_comment} ? ($want_spacing ? "\n" : '') . $e->{pre_comment} : '') . $s . ($e->{comment_on_line} || '') . "\n" . ($e->{post_comment} || ''); +} + +#-############################################################################### +#- refine the data structure for easier use +#-############################################################################### +my %kind_names = ( + Pointer => [ qw(Protocol Device Emulate3Buttons Emulate3Timeout) ], + Mouse => [ qw(DeviceName Protocol Device AlwaysCore Emulate3Buttons Emulate3Timeout) ], # Subsection in XInput + Keyboard => [ qw(Protocol Driver XkbModel XkbLayout XkbDisable) ], + Monitor => [ qw(Identifier VendorName ModelName HorizSync VertRefresh) ], + Device => [ qw(Identifier VendorName BoardName Chipset Driver VideoRam Screen BusID) ], + Display => [ qw(Depth Modes) ], # Subsection in Device + Screen => [ qw(Identifier Driver Device Monitor DefaultColorDepth) ], + InputDevice => [ qw(Identifier Driver Protocol Device XkbModel XkbLayout XkbDisable Emulate3Buttons Emulate3Timeout) ], + ServerLayout => [ qw(Identifier Screen) ], +); +my @want_string = qw(Identifier DeviceName VendorName ModelName BoardName Driver Device Chipset Monitor Protocol XkbModel XkbLayout); + +%kind_names = map_each { lc $::a => [ map { lc } @$::b ] } %kind_names; +@want_string = map { lc } @want_string; + +sub from_raw { + foreach my $e (@_) { + ($e->{l}, my $l) = ({}, $e->{l}); + from_raw__rec($e, $_) foreach @$l; + + delete $e->{kind}; + } + + sub from_raw__rec { + my ($current, $e) = @_; + if ($e->{l}) { + from_raw($e); + push @{$current->{l}{$e->{name}}}, $e; + } else { + if (member(lc $e->{name}, @want_string)) { + $e->{val} =~ s/^"(.*)"$/$1/ or warn "$e->{name} $e->{val} has no quote\n"; + } + + if (member(lc $e->{name}, @{$kind_names{lc $current->{name}} || []})) { + if ($current->{l}{$e->{name}} && !$current->{l}{$e->{name}}{commented}) { + warn "skipping conflicting line for $e->{name} in $current->{name}\n" if !$e->{commented}; + } else { + $current->{l}{$e->{name}} = $e; + } + } else { + push @{$current->{l}{$e->{name}}}, $e; + } + } + delete $e->{name}; + } +} + +sub before_to_string { + my ($e, $depth) = @_; + + if ($e->{l}) { + $e->{kind} = $depth ? 'Subsection' : 'Section'; + + my %rated = map_index { $_ => $::i + 1 } @{$kind_names{lc $e->{name}} || []}; + my @sorted = sort { ($rated{lc $a} || 99) <=> ($rated{lc $b} || 99) } keys %{$e->{l}}; + $e->{l} = [ map { + my $name = $_; + map { + before_to_string({ name => $name, %$_ }, $depth+1); + } deref_array($e->{l}{$name}); + } @sorted ]; + } elsif (member(lc $e->{name}, @want_string)) { + $e->{val} = qq("$e->{val}"); + } + $e; +} diff --git a/perl-install/Xconfig/xfree.pm b/perl-install/Xconfig/xfree.pm new file mode 100644 index 000000000..7b6ba3e37 --- /dev/null +++ b/perl-install/Xconfig/xfree.pm @@ -0,0 +1,76 @@ +package Xconfig::xfree; # $Id$ + +use diagnostics; +use strict; + +use MDK::Common; +use Xconfig::parse; +use Xconfig::xfree3; +use Xconfig::xfree4; +use log; + + +sub read { + my ($class) = @_; + bless { xfree3 => Xconfig::xfree3->read, + xfree4 => Xconfig::xfree4->read }, $class; +} +sub write { + my ($both) = @_; + $both->{xfree3}->write; + $both->{xfree4}->write; +} + +sub empty_config { + my ($class) = @_; + bless { xfree3 => Xconfig::xfree3->empty_config, + xfree4 => Xconfig::xfree4->empty_config }, $class; +} + +sub get_keyboard { get_both('get_keyboard', @_) } +sub set_keyboard { set_both('set_keyboard', @_) } +sub get_mice { get_both('get_mice', @_) } +sub set_mice { set_both('set_mice', @_) } + + + + +#-############################################################################## +#- helpers +#-############################################################################## +sub get_both { + my ($getter, $both) = @_; + + my @l3 = $both->{xfree3}->$getter; + my @l4 = $both->{xfree4}->$getter; + mapn { + my ($h3, $h4) = @_; + my %h = %$h4; + foreach (keys %$h3) { + if (exists $h{$_}) { + my $s4 = join(", ", deref_array($h{$_})); + my $s3 = join(", ", deref_array($h3->{$_})); + my $s3_ = join(", ", map { qq("$_") } deref_array($h3->{$_})); + if ($s4 eq $s3_) { + #- keeping the non-double-quoted value + $h{$_} = $h3->{$_}; + } else { + $s4 eq $s3 or log::l(qq(XFree: conflicting value for $_, "$s4" and "$s3" are different)); + } + } else { + $h{$_} = $h3->{$_}; + } + } + \%h; + } \@l3, \@l4; +} +sub set_both { + my ($setter, $both, @l) = @_; + + $both->{xfree3}->$setter(@l); + $both->{xfree4}->$setter(@l); +} + + + +1; diff --git a/perl-install/Xconfig/xfree3.pm b/perl-install/Xconfig/xfree3.pm new file mode 100644 index 000000000..7b2081dfc --- /dev/null +++ b/perl-install/Xconfig/xfree3.pm @@ -0,0 +1,56 @@ +package Xconfig::xfree3; # $Id$ + +use diagnostics; +use strict; + +use MDK::Common; +use Xconfig::parse; +use Xconfig::xfreeX; + +our @ISA = 'Xconfig::xfreeX'; + +sub config_file { '/etc/X11/XF86Config' } + + +sub get_keyboard_section { + my ($raw_X) = @_; + return $raw_X->get_Section('Keyboard') or die "no keyboard section"; +} + +sub new_keyboard_section { + my ($raw_X) = @_; + return $raw_X->add_Section('Keyboard', { Protocol => { val => 'Standard' } }); +} + +sub get_mouse_sections { + my ($raw_X) = @_; + my $main = $raw_X->get_Section('Pointer') or die "no mouse section"; + my $XInput = $raw_X->get_Section('XInput'); + $main, if_($XInput, map { $_->{l} } @{$XInput->{Mouse} || []}); +} + +sub new_mouse_sections { + my ($raw_X, $nb_new) = @_; + + $raw_X->remove_Section('Pointer'); + my $XInput = $raw_X->get_Section('XInput'); + delete $XInput->{Mouse} if $XInput; + $raw_X->remove_Section('XInput') if $nb_new <= 1 && $XInput && !%$XInput; + + $nb_new or return; + + my $main = $raw_X->add_Section('Pointer', {}); + + if ($nb_new == 1) { + $main; + } else { + my @l = map { { DeviceName => { val => "Mouse$_" }, AlwaysCore => {} } } (2 .. $nb_new); + $XInput ||= $raw_X->add_Section('XInput', {}); + $XInput->{Mouse} = [ map { { l => $_ } } @l ]; + $main, @l; + } +} + +sub set_Option {} + +1; diff --git a/perl-install/Xconfig/xfree4.pm b/perl-install/Xconfig/xfree4.pm new file mode 100644 index 000000000..a160da458 --- /dev/null +++ b/perl-install/Xconfig/xfree4.pm @@ -0,0 +1,84 @@ +package Xconfig::xfree4; # $Id$ + +use diagnostics; +use strict; + +use MDK::Common; +use Xconfig::parse; +use Xconfig::xfree; + +our @ISA = 'Xconfig::xfreeX'; + +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 $ServerLayout = get_ServerLayout($raw_X); + push @{$ServerLayout->{InputDevice}}, { 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_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 { $_[0]{Driver}{val} eq $Driver }); +} +sub remove_InputDevices { + my ($raw_X, $Driver) = @_; + $raw_X->remove_Section('InputDevice', sub { $_[0]{Driver}{val} ne $Driver }); +} + +sub get_ServerLayout { + my ($raw_X) = @_; + $raw_X->get_Section('ServerLayout') || + $raw_X->add_Section('ServerLayout', { Identifier => { val => 'layout1' } }); +} + +1; diff --git a/perl-install/Xconfig/xfreeX.pm b/perl-install/Xconfig/xfreeX.pm new file mode 100644 index 000000000..d782bca1d --- /dev/null +++ b/perl-install/Xconfig/xfreeX.pm @@ -0,0 +1,142 @@ +package Xconfig::xfreeX; # $Id$ + +use diagnostics; +use strict; + +use MDK::Common; +use Xconfig::parse; +use log; + + +sub empty_config { + my ($class) = @_; + my $raw_X = Xconfig::parse::read_XF86Config_from_string(our $default_header); + bless $raw_X, $class; +} + +sub read { + my ($class, $file) = @_; + $file ||= ($::prefix || '') . (bless {}, $class)->config_file; + my $raw_X = Xconfig::parse::read_XF86Config($file); + bless $raw_X, $class; +} +sub write { + my ($raw_X, $file) = @_; + $file ||= ($::prefix || '') . $raw_X->config_file; + Xconfig::parse::write_XF86Config($raw_X, $file); +} + + +my @keyboard_fields = qw(XkbLayout XkbModel XkbDisable); +sub get_keyboard { + my ($raw_X) = @_; + my $raw_kbd = $raw_X->get_keyboard_section; + raw_export_section($raw_kbd, @keyboard_fields); +} +sub set_keyboard { + my ($raw_X, $kbd) = @_; + my $raw_kbd = eval { $raw_X->get_keyboard_section } || $raw_X->new_keyboard_section; + raw_import_section($raw_kbd, $kbd); + $raw_X->set_Option('keyboard', $raw_kbd, keys %$kbd); +} + +#- example: { Protocol => 'IMPS/2', Device => '/dev/psaux', Emulate3Buttons => undef, Emulate3Timeout => 50, ZAxisMapping => [ '4 5', '6 7' ] } +my @mouse_fields = qw(Protocol Device ZAxisMapping Emulate3Buttons Emulate3Timeout); #-); +sub get_mice { + my ($raw_X) = @_; + my @raw_mice = $raw_X->get_mouse_sections; + map { raw_export_section($_, @mouse_fields) } @raw_mice; +} +sub set_mice { + my ($raw_X, @mice) = @_; + my @raw_mice = $raw_X->new_mouse_sections(int @mice); + mapn { + my ($raw_mouse, $mouse) = @_; + raw_import_section($raw_mouse, $mouse); + $raw_X->set_Option('mouse', $raw_mouse, keys %$mouse); + } \@raw_mice, \@mice; +} + + +#-############################################################################## +#- helpers +#-############################################################################## +sub raw_export_section_name { + my ($section, $name) = @_; + my $h = $section->{$name} or return; + + my @l = map { if_(!$_->{commented}, $_->{val}) } deref_array($h) or return; + $name => (ref($h) eq 'ARRAY' ? \@l : $l[0]); +} + +sub raw_export_section { + my ($section, @fields) = @_; + my %h = map { raw_export_section_name($section, $_) } @fields; + \%h; +} + +sub raw_import_section { + my ($section, $h) = @_; + foreach (keys %$h) { + my @l = map { { val => $_ } } deref_array($h->{$_}); + $section->{$_} = (ref($h->{$_}) eq 'ARRAY' ? \@l : $l[0]); + } +} + +sub add_Section { + my ($raw_X, $Section, $h) = @_; + my @suggested_ordering = qw(Files ServerFlags Keyboard Pointer XInput InputDevice Module DRI Monitor Device Screen ServerLayout); + my %order = map_index { { lc($_) => $::i } } @suggested_ordering; + my $e = { name => $Section, l => $h }; + my $added; + @$raw_X = map { + if ($order{lc $_->{name}} > $order{lc $Section} && !$added) { + $added = 1; + ($e, $_); + } else { $_ } + } @$raw_X; + push @$raw_X, $e if !$added; + $h; +} +sub remove_Section { + my ($raw_X, $Section, $when) = @_; + @$raw_X = grep { $_->{name} ne $Section || ($when && $when->($_->{l})) } @$raw_X; + $raw_X; +} +sub get_Sections { + my ($raw_X, $Section, $when) = @_; + map { if_($_->{name} eq $Section && (!$when || $when->($_->{l})), $_->{l}) } @$raw_X; +} +sub get_Section { + my ($raw_X, $Section, $when) = @_; + my @l = get_Sections($raw_X, $Section, $when); + @l > 1 and log::l("Xconfig: found more than one Section $Section"); + $l[0]; +} + + +our $default_header = <<'END'; +# File generated by XFdrake. + +# ********************************************************************** +# Refer to the XF86Config man page for details about the format of +# this file. +# ********************************************************************** + +Section "Files" + # Multiple FontPath entries are allowed (they are concatenated together) + # By default, Mandrake 6.0 and later now use a font server independent of + # the X server to render fonts. + FontPath "unix/:-1" +EndSection + +Section "ServerFlags" + #DontZap # disable (server abort) + #DontZoom # disable / (resolution switching) + AllowMouseOpenFail # allows the server to start up even if the mouse doesn't work +EndSection +END + + +1; + -- cgit v1.2.1