summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Xconfig.pm28
-rw-r--r--perl-install/Xconfigurator.pm90
-rw-r--r--perl-install/Xconfigurator_consts.pm27
-rw-r--r--perl-install/commands.pm3
-rw-r--r--perl-install/common.pm6
-rw-r--r--perl-install/install2.pm17
-rw-r--r--perl-install/install_any.pm6
-rw-r--r--perl-install/install_steps.pm4
-rw-r--r--perl-install/install_steps_interactive.pm38
-rw-r--r--perl-install/interactive_gtk.pm4
-rw-r--r--perl-install/modules.pm25
-rw-r--r--perl-install/my_gtk.pm6
-rw-r--r--perl-install/pkgs.pm3
-rw-r--r--perl-install/printer.pm16
14 files changed, 165 insertions, 108 deletions
diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm
index acab3ca55..48b1cddca 100644
--- a/perl-install/Xconfig.pm
+++ b/perl-install/Xconfig.pm
@@ -1,6 +1,7 @@
package Xconfig;
use common qw(:common :file :system);
+use mouse;
# otherwise uses the rule substr($keymap, 0, 2)
my %keymap_translate = (
@@ -17,18 +18,14 @@ sub keymap_translate {
sub getinfo {
- my $o = {};
+ my $o = { monitor => { hsyncrange => "30-54" } };
# getinfoFromXF86Config($o);
getinfoFromDDC($o);
getinfoFromSysconfig($o);
- $o->{mouse}{emulate3buttons} = 1;
- unless ($o->{mouse}{XMOUSETYPE}) {
- my ($type, $dev) = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
- $o->{mouse}{XMOUSETYPE} ||= $type;
- $o->{mouse}{device} ||= "/dev/$dev";
- }
- $o->{mouse}{device} ||= "/dev/mouse" if -e "/dev/mouse";
+ add2hash($o->{mouse}, mouse::detect()) unless $o->{mouse}{XMOUSETYPE};
+
+ $o->{mouse}{device} ||= "mouse" if -e "/dev/mouse";
$o;
}
@@ -45,7 +42,7 @@ sub getinfoFromXF86Config {
$o->{keyboard}{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
} elsif (/^Section "Pointer"/ .. /^EndSection/) {
$o->{mouse}{XMOUSETYPE} ||= $1 if /^\s*Protocol\s+"(.*?)"/;
- $o->{mouse}{device} ||= $1 if /^\s*Device\s+"(.*?)"/;
+ $o->{mouse}{device} ||= $1 if m|^\s*Device\s+"/dev/(.*?)"|;
} elsif (my $i = /^Section "Device"/ .. /^EndSection/) {
if ($i = 1 && $c{type} && $c{type} ne "Generic VGA") {
add2hash($o->{card} ||= {}, \%c);
@@ -81,9 +78,9 @@ sub getinfoFromXF86Config {
sub getinfoFromSysconfig {
my $o = shift || {};
- if (my %mouse = getVarsFromSh "/etc/sysconfig/mouse") {
- $o->{mouse}{XMOUSETYPE} ||= $mouse{XMOUSETYPE};
- }
+
+ add2hash($o->{mouse}, mouse::read("/etc/sysconfig/mouse"));
+
if (my %keyboard = getVarsFromSh "/etc/sysconfig/keyboard") {
$keyboard{KEYTABLE} or last;
$o->{keyboard}{xkb_keymap} ||= keymap_translate($keyboard{KEYTABLE});
@@ -98,7 +95,7 @@ sub getinfoFromDDC {
my ($m, @l) = `ddcxinfos`;
$? == 0 or return $o;
- $o->{card}{memory} = to_int($m);
+ $o->{card}{memory} ||= to_int($m);
while (($_ = shift @l) ne "\n") {
my ($depth, $x, $y) = split;
$depth = int(log($depth) / log(2));
@@ -107,11 +104,12 @@ sub getinfoFromDDC {
push @{$o->{card}{depth}{32}}, [ $x, $y ] if $depth == 24;
}
}
- my ($h, $v, @m) = @l;
+ my ($h, $v, $size, @m) = @l;
chop $h; chop $v;
$O->{hsyncrange} ||= $h;
$O->{vsyncrange} ||= $v;
- $O->{modelines} ||= join '', @l;
+ $O->{size} ||= to_float($size);
+ $O->{modelines} ||= join '', @m;
$o;
}
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 41edd3e3d..05d5983b1 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -2,10 +2,10 @@ package Xconfigurator;
use diagnostics;
use strict;
-use vars qw($in $install $resolution_wanted @depths @hsyncranges @vsyncranges %depths @resolutions @svgaservers @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $intro_text $finalcomment_text $s3_comment $cirrus_comment $probeonlywarning_text $monitorintro_text $hsyncintro_text $vsyncintro_text $XF86firstchunk_text $keyboardsection_start $keyboardsection_part2 $keyboardsection_end $pointersection_text1 $pointersection_text2 $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text $devicesection_text $screensection_text1);
+use vars qw($in $install $resolution_wanted @depths @monitorSize2resolution @hsyncranges %min_hsync4wres @vsyncranges %depths @resolutions @svgaservers @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $intro_text $finalcomment_text $s3_comment $cirrus_comment $probeonlywarning_text $monitorintro_text $hsyncintro_text $vsyncintro_text $XF86firstchunk_text $keyboardsection_start $keyboardsection_part2 $keyboardsection_end $pointersection_text1 $pointersection_text2 $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text $devicesection_text $screensection_text1);
use pci_probing::main;
-use common qw(:common :file);
+use common qw(:common :file :functional);
use log;
use Xconfigurator_consts;
@@ -125,12 +125,18 @@ sub rewriteInittab {
}
sub keepOnlyLegalModes {
- my ($card) = @_;
- my $mem = 1024 * ($card->{memory} || return);
+ my ($card, $monitor) = @_;
+ my $mem = 1024 * ($card->{memory} || 99999);
+ my $hsync = max(split(/[,-]/, $monitor->{hsyncrange}));
while (my ($depth, $res) = each %{$card->{depth}}) {
- @$res = grep { $mem >= product(@$_, $depth / 8) } @$res;
+ @$res = grep {
+ $mem >= product(@$_, $depth / 8) &&
+ $hsync >= ($min_hsync4wres{$_->[0]} || 0)
+ } @$res;
+ delete $card->{depth}{$depth} if @$res == 0;
}
+
}
sub cardConfigurationAuto() {
@@ -217,6 +223,8 @@ sub testConfig($) {
write_XF86Config($o, $tmpconfig);
+ unlink "/tmp/.X9-lock";
+
local *F;
open F, "$prefix$o->{card}{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
foreach (<F>) {
@@ -253,6 +261,8 @@ sub testFinalConfig($;$) {
or $in->ask_yesorno(_("Test configuration"), _("Do you want to test the configuration?"))
or return 1;
+ unlink "$prefix/tmp/.X9-lock";
+
my $pid; unless ($pid = fork) {
my @l = "X";
@l = ($o->{card}{prog}, "-xf86config", $tmpconfig) if $::testing;
@@ -330,8 +340,7 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur
}
sub autoDefaultDepth($$) {
- my ($card, $resolution_wanted) = @_;
- my ($wres_wanted) = split 'x', $resolution_wanted;
+ my ($card, $wres_wanted) = @_;
my ($best, $depth);
while (my ($d, $r) = each %{$card->{depth}}) {
@@ -343,13 +352,17 @@ sub autoDefaultDepth($$) {
$best || $depth or die "no valid modes";
}
-sub chooseResolutions($$) {
- my ($card, $chosen_depth) = @_;
+sub autoDefaultResolution(;$) {
+ my $size = round(shift || 14); #- assume a small monitor (size is in inch)
+ $monitorSize2resolution[$size] ||
+ $monitorSize2resolution[$#monitorSize2resolution]; #- no corresponding resolution for this size. It means a big monitor, take biggest we have
+}
+sub chooseResolutions($$;$) {
+ my ($card, $chosen_depth, $chosen_w) = @_;
my $W = my_gtk->new(_("Resolution"));
my %txt2depth = reverse %depths;
- my $chosen_w = 9999999; #- will be set by the combo callback
- my ($r, $depth_combo, %w2depth, %w2h, %w2widget);
+ my ($r, $best_w, $depth_combo, %w2depth, %w2h, %w2widget);
my $set_depth = sub { $depth_combo->entry->set_text(translate($depths{$chosen_depth})) };
@@ -361,11 +374,15 @@ sub chooseResolutions($$) {
foreach (@$res) {
$w2h{$_->[0]} = $_->[1];
push @{$w2depth{$_->[0]}}, $depth;
+
+ $best_w = max($_->[0], $best_w) if $_->[0] <= $chosen_w;
}
}
+ $chosen_w = $best_w;
while (my ($w, $h) = each %w2h) {
my $V = $w . "x" . $h;
$w2widget{$w} = $r = new Gtk::RadioButton($r ? ($V, $r) : $V);
+ &$set($r) if $chosen_w == $w;
$r->signal_connect("clicked" => sub {
$ignore and return;
$chosen_w = $w;
@@ -397,18 +414,16 @@ sub chooseResolutions($$) {
$chosen_w > $w and &$set($w2widget{$chosen_w = $w});
});
&$set_depth();
+ $W->{ok}->grab_focus;
$W->main or return;
($chosen_depth, $chosen_w);
}
-sub resolutionsConfiguration($$) {
- my ($o, $option) = @_;
+sub resolutionsConfiguration($%) {
+ my ($o, %options) = @_;
my $card = $o->{card};
- my $auto = $option eq 'auto';
- my $nowarning = $auto || $option eq 'nowarning';
- my $noauto = $option eq 'noauto';
#- For the mono and vga16 server, no further configuration is required.
if (member($card->{server}, "Mono", "VGA16")) {
@@ -445,35 +460,38 @@ sub resolutionsConfiguration($$) {
$card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ]
foreach @depths;
- if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"),
+ unless ($options{noauto}) {
+ if ($options{nowarning} || $in->ask_okcancel(_("Automatic resolutions"),
_("I can try to find the available resolutions (eg: 800x600).
Alas it can freeze sometimes
-Do you want to try?")))) {
- autoResolutions($o, $nowarning);
- is_empty_hash_ref($card->{depth}) and $in->ask_warn('',
+Do you want to try?"))) {
+ autoResolutions($o, $options{nowarning});
+ is_empty_hash_ref($card->{depth}) and $in->ask_warn('',
_("No valid modes found
Try with another video card or monitor")), return;
+ }
}
}
#- sort resolutions in each depth
foreach (values %{$card->{depth}}) {
- my $i;
+ my $i = 0;
@$_ = grep { first($i != $_->[0], $i = $_->[0]) }
sort { $b->[0] <=> $a->[0] } @$_;
}
- #- remove unusable resolutions (based on the video memory size)
- keepOnlyLegalModes($card);
+ #- remove unusable resolutions (based on the video memory size and the monitor hsync rate)
+ keepOnlyLegalModes($card, $o->{monitor});
- my $res = $o->{resolution_wanted} || $resolution_wanted;
- my $depth = eval { $card->{default_depth} || autoDefaultDepth($card, $res) };
+ my $res = $o->{resolution_wanted} || autoDefaultResolution($o->{monitor}{size});
+ my $wres = first(split 'x', $res);
+ my $depth = eval { $card->{default_depth} || autoDefaultDepth($card, $wres) };
- $auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
+ $options{auto} or ($depth, $wres) = chooseResolutions($card, $depth, $wres) or return;
- unless ($res) {
+ unless ($wres) {
delete $card->{depth};
- return resolutionsConfiguration($o, 'noauto');
+ return resolutionsConfiguration($o, noauto => 1);
}
#- needed in auto mode when all has been provided by the user
@@ -481,7 +499,7 @@ Try with another video card or monitor")), return;
#- remove all biggest resolution (keep the small ones for ctl-alt-+)
#- otherwise there'll be a virtual screen :(
- $card->{depth}{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}{$depth}} ];
+ $card->{depth}{$depth} = [ grep { $_->[0] <= $wres } @{$card->{depth}{$depth}} ];
$card->{default_depth} = $depth;
1;
}
@@ -510,15 +528,15 @@ sub write_XF86Config {
$O = $o->{mouse};
print F $pointersection_text1;
print F qq( Protocol "$O->{XMOUSETYPE}"\n);
- print F qq( Device "$O->{device}"\n);
+ print F qq( Device "/dev/$O->{device}"\n);
#- this will enable the "wheel" or "knob" functionality if the mouse supports it
print F " ZAxisMapping 4 5\n" if
member($O->{XMOUSETYPE}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2));
print F $pointersection_text2;
- print F "#" unless $O->{emulate3buttons};
+ print F "#" unless $O->{XEMU3};
print F " Emulate3Buttons\n";
- print F "#" unless $O->{emulate3buttons};
+ print F "#" unless $O->{XEMU3};
print F " Emulate3Timeout 50\n\n";
print F "# ChordMiddle is an option for some 3-button Logitech mice\n\n";
print F "#" unless $O->{chordmiddle};
@@ -593,7 +611,7 @@ Section "Screen"
print F qq( EndSubsection\n);
}
print F "EndSection\n";
- };
+ }; #-"
#- SVGA screen section.
print F qq(
@@ -660,7 +678,7 @@ sub main {
$o->{monitor} = monitorConfiguration($o->{monitor});
- my $ok = resolutionsConfiguration($o, $::auto && 'auto' || $::noauto && 'noauto' || '');
+ my $ok = resolutionsConfiguration($o, auto => $::auto, noauto => $::noauto);
$ok &&= testFinalConfig($o, $::auto);
@@ -670,10 +688,10 @@ sub main {
my %c = my @c = (
__("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() },
__("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto') },
- __("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
+ __("Change Resolution") => sub { resolutionsConfiguration($o, noauto => 1) },
__("Automatical resolutions search") => sub {
delete $o->{card}{depth};
- resolutionsConfiguration($o, 'nowarning');
+ resolutionsConfiguration($o, nowarning => 1);
},
__("Show information") => sub { show_info($o) },
__("Test again") => sub { $ok = testFinalConfig($o, 1) },
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index 9429342eb..b44acf52b 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -16,6 +16,25 @@ $resolution_wanted = "1024x768";
@accelservers = qw(S3 Mach32 Mach8 8514 P9000 AGX W32 Mach64 I128 S3V 3DLabs);
@allservers = (qw(Mono VGA16), @svgaservers, @accelservers);
+{ #- @monitorSize2resolution
+ my %l = my @l = ( #- size in inch
+ 13 => "640x480",
+ 14 => "800x600",
+ 15 => "800x600",
+ 16 => "1024x768",
+ 17 => "1152x864",
+ 18 => "1280x1024",
+ 19 => "1280x1024",
+ 20 => "1600x1200",
+ );
+ for (my $i = 0; $i < $l[0]; $i++) {
+ $monitorSize2resolution[$i] = $l[1];
+ }
+ while (my ($s, $r) = each %l) {
+ $monitorSize2resolution[$s] = $r;
+ }
+}
+
%videomemory = (
__("256 kb") => 256,
__("512 kb") => 512,
@@ -59,6 +78,14 @@ $resolution_wanted = "1024x768";
"31.5-94.0",
);
+%min_hsync4wres = (
+ 640 => 31.5,
+ 800 => 35.1,
+ 1024 => 35.5,
+ 1152 => 44.0,
+ 1280 => 51.0,
+ 1600 => 75.0,
+);
#- * Screen/video card configuration.
%ramdacs = (
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 2ae11bf8e..a0a9053d6 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -40,9 +40,10 @@ sub rmdir_ { foreach (@_) { rmdir $_ or die "rmdir: can't remove $_\n" } }
sub lsmod { print "Module Size Used by\n"; cat("/proc/modules"); }
sub grep_ {
- my ($h, $v) = getopts(\@_, qw(hv));
+ my ($h, $v, $i) = getopts(\@_, qw(hvi));
@_ == 0 || $h and die "usage: grep <regexp> [files...]\n";
my $r = shift;
+ $r = qr/$r/i if $i;
@ARGV = @_; (/$r/ ? $v || print : $v && print) while <>
}
diff --git a/perl-install/common.pm b/perl-install/common.pm
index e2a135cdc..8b158f010 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- common => [ qw(__ min max sum sign product bool listlength bool2text to_int ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
+ common => [ qw(__ min max sum sign product bool listlength bool2text to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash set_new set_add round round_up round_down first second top uniq translate untranslate warp_text) ],
functional => [ qw(fold_left map_index map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
@@ -46,7 +46,8 @@ sub first { $_[0] }
sub second { $_[1] }
sub top { $_[$#_] }
sub uniq { my %l; @l{@_} = (); keys %l }
-sub to_int { $_[0] =~ /(\d+)/; $1 }
+sub to_int { $_[0] =~ /(\d*)/; $1 }
+sub to_float { $_[0] =~ /(\d*(\.\d*)?)/; $1 }
sub ikeys { my %l = @_; sort { $a <=> $b } keys %l }
sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } }
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
@@ -59,6 +60,7 @@ sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] }
sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = <F>; wantarray ? @l : join '', @l }
sub chop_ { map { my $l = $_; chomp $l; $l } @_ }
sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
+sub round { int ($_[0] + 0.5) }
sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 50809e007..67c13df6a 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -16,6 +16,7 @@ use help;
use network;
use lang;
use keyboard;
+use mouse;
use fs;
use fsedit;
use devices;
@@ -36,13 +37,13 @@ my @installSteps = (
selectLanguage => [ __("Choose your language"), 1, 1 ],
selectPath => [ __("Choose install or upgrade"), 0, 0 ],
selectInstallClass => [ __("Select installation class"), 1, 1, "selectPath" ],
+ selectMouse => [ __("Configure mouse"), 1, 1 ],
selectKeyboard => [ __("Choose your keyboard"), 1, 1 ],
setupSCSI => [ __("Setup SCSI"), 1, 0 ],
partitionDisks => [ __("Setup filesystems"), 1, 0 ],
formatPartitions => [ __("Format partitions"), 1, -1, "partitionDisks" ],
choosePackages => [ __("Choose packages to install"), 1, 1, "selectInstallClass" ],
doInstallStep => [ __("Install system"), 1, -1, ["formatPartitions", "selectPath"] ],
- configureMouse => [ __("Configure mouse"), 1, 1, "formatPartitions" ],
configureNetwork => [ __("Configure networking"), 1, 1, "formatPartitions" ],
configureTimezone => [ __("Configure timezone"), 1, 1, "doInstallStep" ],
#- configureServices => [ __("Configure services"), 0, 0 ],
@@ -205,6 +206,12 @@ sub selectLanguage {
}
#------------------------------------------------------------------------------
+sub selectMouse {
+ $o->selectMouse($_[0]);
+ addToBeDone { mouse::write($o->{mouse}, $o->{prefix}); } 'formatPartitions';
+}
+
+#------------------------------------------------------------------------------
sub selectKeyboard {
my ($clicked) = $_[0];
return if $::beginner && !$clicked;
@@ -240,7 +247,7 @@ sub setupSCSI {
my ($clicked) = $_[0];
$o->{autoSCSI} ||= $::beginner;
- $o->setupSCSI($o->{autoSCSI} && !$clicked);
+ $o->setupSCSI($o->{autoSCSI} && !$clicked, $clicked);
}
#------------------------------------------------------------------------------
@@ -306,8 +313,6 @@ sub doInstallStep {
}
#------------------------------------------------------------------------------
-sub configureMouse { $o->mouseConfig }
-#------------------------------------------------------------------------------
sub configureNetwork {
my ($clicked, $entered) = @_;
$o->configureNetwork($entered == 1 && !$clicked)
@@ -432,7 +437,7 @@ sub main {
$ENV{LD_LIBRARY_PATH} = "";
#- needed very early for install_steps_graphical
- $o->{mouse} = install_any::mouse_detect() unless $::testing || $o->{mouse};
+ $o->{mouse} ||= mouse::detect() unless $::testing;
$::o = $o = $::auto_install ?
install_steps->new($o) :
@@ -455,7 +460,7 @@ sub main {
MAIN: for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) {
$o->{steps}{$o->{step}}{entered}++;
$o->enteringStep($o->{step});
- eval {
+ eval {
&{$install2::{$o->{step}}}($clicked, $o->{steps}{$o->{step}}{entered});
};
$o->kill_action;
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 07480df6c..d0b6c2fa9 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -86,12 +86,6 @@ sub spawnShell {
exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!");
}
-sub mouse_detect() {
- my %l;
- @l{qw(MOUSETYPE XMOUSETYPE DEVICE)} = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
- \%l;
-}
-
sub shells($) {
my ($o) = @_;
my @l = grep { -x "$o->{prefix}$_" } @{$o->{shells}};
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 1cb0cca1e..e61e8bba9 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -158,10 +158,8 @@ sub afterInstallPackages($) {
}
#------------------------------------------------------------------------------
-sub mouseConfig($) {
+sub selectMouse($) {
my ($o) = @_;
- setVarsInSh("$o->{prefix}/etc/sysconfig/mouse", $o->{mouse});
- symlink $o->{mouse}{DEVICE}, "$o->{prefix}/dev/mouse" or log::l("creating /dev/mouse symlink failed");
}
#------------------------------------------------------------------------------
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index a742dc26d..d9800bdea 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -18,6 +18,7 @@ use install_any;
use detect_devices;
use timezone;
use network;
+use mouse;
use modules;
use lang;
use pkgs;
@@ -87,7 +88,26 @@ sub selectInstallClass($@) {
}
#------------------------------------------------------------------------------
-sub setupSCSI { setup_thiskind($_[0], 'scsi', $_[1]) }
+sub selectMouse {
+ my ($o, $force) = @_;
+
+ my $name = $o->{mouse}{FULLNAME};
+ if (!$name || $::expert || $force) {
+ $name = $o->ask_from_list_('', _("Which mouse do you have"), [ mouse::names() ], $name);
+ $o->{mouse} = mouse::name2mouse($name);
+ }
+ my $b = $o->{mouse}{nbuttons} < 3;
+ $o->{mouse}{XEMU3} = 'yes' if $::expert && $o->ask_yesorno('', _("Emulate third button"), $b) || $b;
+
+ $o->{mouse}{device} = mouse::serial_ports_names2dev(
+ $o->ask_from_list(_("Mouse Port"),
+ _("Which serial port is your mouse connected to?"),
+ [ mouse::serial_ports_names() ])) if $o->{mouse}{device} eq "ttyS";
+
+ $o->SUPER::selectMouse;
+}
+#------------------------------------------------------------------------------
+sub setupSCSI { setup_thiskind($_[0], 'scsi', $_[1], $_[2]) }
#------------------------------------------------------------------------------
sub rebootNeeded($) {
my ($o) = @_;
@@ -125,9 +145,6 @@ sub setPackages {
}
#------------------------------------------------------------------------------
-#-mouse
-
-#------------------------------------------------------------------------------
sub configureNetwork($) {
my ($o, $first_time) = @_;
my $r = '';
@@ -617,7 +634,7 @@ sub load_thiskind {
#------------------------------------------------------------------------------
sub setup_thiskind {
my ($o, $type, $auto, $at_least_one) = @_;
- my @l = $o->load_thiskind($type);
+ my @l = $o->load_thiskind($type) unless $::expert && $o->ask_yesorno('', "Skip $type pci probe", 0);
return if $auto && (@l || !$at_least_one);
while (1) {
my $msg = @l ?
@@ -627,14 +644,15 @@ sub setup_thiskind {
my $opt = [ __("Yes"), __("No") ];
push @$opt, __("See hardware info") if $::expert;
- my $r = $o->ask_from_list_('', $msg, $opt);
- $r eq "No" and return;
- if ($r eq "Yes") {
+ my $r = "Yes";
+ $r = $o->ask_from_list_('', $msg, $opt) unless $at_least_one && @l == 0;
+ if ($r eq "No") { return }
+ elsif ($r eq "Yes") {
my @r = $o->loadModule($type) or return;
push @l, \@r;
} else {
- $o->ask_warn('', [ pci_probing::main::list() ]);
- }
+ $o->ask_warn('', [ pci_probing::main::list() ]);
+ }
}
}
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 4f01fcbb7..5d328dc7c 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -28,9 +28,10 @@ sub ask_from_entryW {
sub ask_from_listW {
my ($o, $title, $messages, $l, $def) = @_;
+ my $w = my_gtk->new($title, %$o);
+ $w->{retval} = $def || $l->[0]; #- nearly especially for the X test case (see timeout in Xconfigurator.pm)
if (@$l < 5 && sum(map { length $_ } @$l) < 70) {
my $defW;
- my $w = my_gtk->new($title, %$o);
my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
gtkadd($w->{window},
gtkpack(create_box_with_title($w, @$messages),
@@ -46,7 +47,6 @@ sub ask_from_listW {
$defW->grab_focus if $defW;
$w->main;
} else {
- my $w = my_gtk->new($title);
$w->_ask_from_list($messages, $l, $def);
$w->main;
}
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 22584aa1b..076feab51 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -295,22 +295,19 @@ sub get_stage1_conf {
sub load_thiskind($;&) {
my ($type, $f) = @_;
- unless ($::testing) {
- my @devs = pci_probing::main::probe($type);
- log::l("pci probe found " . scalar @devs . " $type devices");
+
+ my @devs = pci_probing::main::probe($type);
+ log::l("pci probe found " . scalar @devs . " $type devices");
- my %devs; foreach (@devs) {
- my ($text, $mod) = @$_;
- $devs{$mod}++ and log::l("multiple $mod devices found"), next;
- $drivers{$mod} or log::l("module $mod not in install table"), next;
- log::l("found driver for $mod");
- &$f($text, $mod) if $f;
- load($mod, $type);
- }
- @devs;
- } else {
- ();
+ my %devs; foreach (@devs) {
+ my ($text, $mod) = @$_;
+ $devs{$mod}++ and log::l("multiple $mod devices found"), next;
+ $drivers{$mod} or log::l("module $mod not in install table"), next;
+ log::l("found driver for $mod");
+ &$f($text, $mod) if $f;
+ load($mod, $type);
}
+ @devs;
}
#-#- This assumes only one of each driver type is loaded
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index f3228358f..5f9159df5 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -38,7 +38,8 @@ sub main($;$) {
my ($o, $f) = @_;
$o->show;
- do {
+ do {
+ local $::setstep = 1;
Gtk->main
} while ($o->{retval} && $f && !&$f());
$o->destroy;
@@ -377,8 +378,9 @@ sub _ask_from_list($$$$) {
$curr++ if $starting_word eq '' || $starting_word eq $c;
$starting_word .= $c unless $starting_word eq $c;
+ my $word = quotemeta $starting_word;
my $j; for ($j = 0; $j < @$l; $j++) {
- $l->[($j + $curr) % @$l] =~ /^$starting_word/i and last;
+ $l->[($j + $curr) % @$l] =~ /^$word/i and last;
}
$j == @$l ?
$starting_word = '' :
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index d5330809b..de156d498 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -275,7 +275,6 @@ sub install {
foreach my $p (@$toInstall) {
eval { getHeader($p) }; $@ and next;
- $p->{installed} = 1;
$p->{file} ||= sprintf "%s-%s-%s.%s.rpm",
$p->{name}, $p->{version}, $p->{release},
c::headerGetEntry(getHeader($p), 'arch');
@@ -313,4 +312,6 @@ sub install {
c::rpmtransFree($trans);
c::rpmdbClose($db);
log::l("rpm database closed");
+
+ $_->{installed} = 1 foreach @$toInstall;
}
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 2724b6988..5d3d9bb63 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -266,9 +266,7 @@ $spooldir = "/var/spool/lpd";
#-#####################################################################################
-sub set_prefix($) {
- ($prefix) = @_;
-}
+sub set_prefix($) { $prefix = $_[0]; }
#-*****************************************************************************
#- read function
#-*****************************************************************************
@@ -276,19 +274,17 @@ sub set_prefix($) {
#- Read the printer database from dbpath into memory
#------------------------------------------------------------------------------
sub read_printer_db(;$) {
- my ($dbpath) = @_;
-
- $dbpath = $prefix . ($dbpath || $PRINTER_DB_FILE);
+ my $dbpath = $prefix . ($_[0] || $PRINTER_DB_FILE);
%thedb and return;
local *DBPATH; #-don't have to do close
- open DBPATH, "<$dbpath" or die "An error has occurred on $dbpath : $!";
+ open DBPATH, $dbpath or die "An error has occurred on $dbpath : $!";
while (<DBPATH>) {
if (/^StartEntry:\s(\w*)/) {
my $entryname = $1;
- my $entry = {};
+ my $entry;
$entry->{ENTRY} = $entryname;
@@ -363,7 +359,7 @@ sub create_config_file($$%) {
#-TODO my $oldmask = umask 0755;
- open IN , "<$in" or die "Can't open $in $!";
+ open IN , $in or die "Can't open $in $!";
if ($::testing) {
*OUT = *STDOUT
} else {
@@ -396,7 +392,7 @@ sub copy_master_filter($) {
#- given a PrintCap Entry, create the spool dir and special
#- rhs-printfilters related config files which are required
#------------------------------------------------------------------------------
-my $intro_printcap_test="
+my $intro_printcap_test = "
#
# Please don't edit this file directly unless you know what you are doing!
# Look at the printcap(5) man page for more info.
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-14 07:47:35 +0000