summaryrefslogtreecommitdiffstats
path: root/perl-install/Xconfig
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/Xconfig')
-rw-r--r--perl-install/Xconfig/parse.pm192
-rw-r--r--perl-install/Xconfig/xfree.pm76
-rw-r--r--perl-install/Xconfig/xfree3.pm56
-rw-r--r--perl-install/Xconfig/xfree4.pm84
-rw-r--r--perl-install/Xconfig/xfreeX.pm142
5 files changed, 550 insertions, 0 deletions
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 <Crtl><Alt><BS> (server abort)
+ #DontZoom # disable <Crtl><Alt><KP_+>/<KP_-> (resolution switching)
+ AllowMouseOpenFail # allows the server to start up even if the mouse doesn't work
+EndSection
+END
+
+
+1;
+
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-20 16:39:27 +0000