no_comment

8 files changed, 281 insertions, 62 deletions

diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 8b5f151b7..f9f84bdbf 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -2,15 +2,16 @@ package Xconfigurator;
 
 use diagnostics;
 use strict;
-use vars qw($in $resolution_wanted @depths @resolutions @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate @vsync_range %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 @resolutions @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate @vsync_range %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 interactive_gtk;
 use log;
 
 use Xconfigurator_consts;
 
+my $tmpconfig = "/tmp/Xconfig";
+
 1;
 
 sub setVirtual($) {
@@ -52,7 +53,7 @@ sub readCardsDB {
 		add2hash($card, $c);
 	    },
 	    CHIPSET => sub { $card->{chipset} = $val; 
-			     $card->{flags}->{needVideoRam} if member($val, qw(RIVA128));
+			     $card->{flags}->{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128));
 			 },
 	    SERVER => sub { $card->{server} = $val; },
 	    RAMDAC => sub { $card->{ramdac} = $val; },
@@ -148,6 +149,27 @@ sub cardConfiguration(;$) {
     add2hash($card, { type => $in->ask_from_list('', _("Choose a graphic card"), [keys %cards]) }) unless $card->{type} || $card->{server};
     add2hash($card, $cards{$card->{type}}) if $card->{type};
     add2hash($card, { vendor => "Unknown", board => "Unknown" });
+
+    $card->{prog} = "/usr/X11R6/bin/XF86_$card->{server}";
+
+    -x $card->{prog} or !defined $install or &$install($card->{server});
+    -x $card->{prog} or die "server $card->{server} is not available (should be in $card->{prog})";
+
+    unless ($::testing) {
+	unlink("/etc/X11/X");
+	symlink("../../$card->{prog}", "/etc/X11/X");
+    }
+
+    unless ($card->{type}) {
+	$card->{flags}->{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64));
+    }
+
+    $card->{flags}->{needVideoRam} and
+      $card->{memory} ||= 
+	$videomemory{$in->ask_from_list_('', 
+					 _("Give your graphic card memory size"), 
+					 [ sort { $videomemory{$a} <=> $videomemory{$b} } 
+					   keys %videomemory])};
     $card;
 }
 
@@ -166,22 +188,56 @@ sub testConfig($) {
     my ($o) = @_;
     my ($resolutions, $clocklines);
 
-    write_XF86Config($o, "/tmp/Xconfig");
+    write_XF86Config($o, $tmpconfig);
 
     local *F;
-    open F, "/etc/X11/X :9 -probeonly -pn -xf86config /tmp/Xconfig 2>&1 |";
+    open F, "$o->{card}->{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
     foreach (<F>) {
 	#$videomemory = $2 if /(videoram|Video RAM):\s*(\d*)/;
 	# look for clocks
 	push @$clocklines, $1 if /clocks: (.*)/ && !/(pixel |num)clocks:/;
 
 	push @$resolutions, [ $1, $2 ] if /: Mode "(\d+)x(\d+)": mode clock/;
+	print;
     }
     close F or die "X probeonly failed";
 
     ($resolutions, $clocklines);
 }
 
+sub testFinalConfig($) {
+    my ($o) = @_;
+
+    write_XF86Config($o, $::testing ? $tmpconfig : "/etc/X11/XF86Config");
+
+    my $pid; unless ($pid = fork) {
+	my @l = "X";
+	@l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing;
+	exec @l, ":9" or exit 1;
+    }
+    do { sleep 1; } until (c::Xtest(':0'));
+
+    local *F;
+    open F, "|perl" or die;
+    print F "use lib qw(", join(' ', @INC), ");\n";
+    print F q{
+	use interactive_gtk;
+        use my_gtk qw(:wrappers);
+
+	$ENV{DISPLAY} = ":9";
+        gtkset_mousecursor(2);
+        gtkset_background(200, 210, 210);
+        my ($h, $w) = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW)->get_size;
+        $my_gtk::force_position = [ $w / 3, $h / 2.4 ];
+	$my_gtk::force_focus = 1;
+	exit !interactive_gtk->new->ask_yesorno('', _("It this ok?"));
+    };
+    my $rc = close F;
+    kill 2, $pid;
+
+    $rc;
+}
+
 sub autoResolutions($) {
     my ($o) = @_;
     my $card = $o->{card};
@@ -193,11 +249,11 @@ sub autoResolutions($) {
 
     # Configure the modes order.
     my ($ok, $best);
-    foreach (@depths) {
+    foreach (reverse @depths) {
 	local $card->{default_depth} = $_;
 
 	my ($resolutions, $clocklines) = eval { testConfig($o) };
-	if ($@) {
+	if ($@ || !$resolutions) {
 	    delete $card->{depth}->{$_};
 	} else {
 	    $card->{clocklines} ||= $clocklines unless $card->{flags}->{noclockprobe};
@@ -207,30 +263,20 @@ sub autoResolutions($) {
 	    my ($b) = sort { $b->[0] <=> $a->[0] } @$resolutions;
 
 	    # require $resolution_wanted, no matter what bpp this requires
-	    $best = $_ if $b->[0] >= $hres_wanted;
+	    $card->{default_depth} = $_, last if $b->[0] >= $hres_wanted;
 	}
     }
     $ok or die "no valid modes";
-
-    $card->{default_depth} = $best;
 }
 
 
-sub moreCardConfiguration {
-    my ($o) = @_;
+sub resolutionsConfiguration {
+    my ($o, $manual) = @_;
     my $card = $o->{card};
 
-    $card->{vendor} ||= "Unknown";
-    $card->{model} ||= "Unknown";
-
-    unless ($card->{type}) {
-	$card->{flags}->{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64));
-    }
-
-    my $manual;
     # some of these guys hate to be poked               
     # if we dont know then its at the user's discretion
-    #my $manual = 
+    #my $manual ||= 
     #  $card->{server} =~ /^(TGA|Mach32)/ || 
     #  $card->{name} =~ /^Riva 128/ ||
     #  $card->{chipset} =~ /^(RIVA128|mgag)/ ||
@@ -253,25 +299,24 @@ sub moreCardConfiguration {
     #$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
     #						       _("Do you want to try?") ]);
     
-    $card->{flags}->{needVideoRam} and
-      $card->{memory} ||= 
-	$videomemory{$in->ask_from_list_('', 
-					 _("Give your graphic card memory size"), 
-					 [ sort { $videomemory{$a} <=> $videomemory{$b} } 
-					   keys %videomemory])};
+    findLegalModes($card);
 
-    findLegalModes($o->{card});
-
-    unless ($manual || $::expert) {
+    unless ($manual || $::expert || !$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?"))) {
 	# swith to virtual console 1 (hopefully not X :)
 	my $vt = setVirtual(1);
-
-	autoMemoryAndClocksline($o);
 	autoResolutions($o);
-
 	# restore the virtual console
 	setVirtual($vt);
     }
+    my %l;
+    foreach ($card->{depth})
+
+    ask_from_list(_("Resolution"),
+		  _("Choose resolution and color depth"),
+		  [ ]);
 }
 
 
@@ -421,11 +466,13 @@ sub XF86check_link {
     }
 }
 
+
 # * Program entry point. 
 sub main {
-    my ($default, $interact) = @_;
+    my ($default, $interact, $install_pkg) = @_;
     my $o = $default;
     $in = $interact;
+    $install = $install_pkg;
 
     $o->{resolution_wanted} ||= $resolution_wanted;
     
@@ -433,29 +480,27 @@ sub main {
 
     $o->{card} = cardConfiguration($o->{card});
 
-    unless ($::testing) {
-	my $prog = "/usr/X11R6/bin/XF86_$o->{card}->{server}";
-	-x $prog or die "server $o->{card}->{server} is not available (should be in $prog)";
-	unlink("/etc/X11/X");
-	symlink("../../$prog", "/etc/X11/X");
-    }
-
     $o->{monitor} = monitorConfiguration($o->{monitor});
 
-    moreCardConfiguration($o);
+    resolutionsConfiguration($o);
+
+    my $ok = testFinalConfig($o);
+    my $quit;
 
-    write_XF86Config($o, "/tmp/Xconfig");
+    until ($ok || $quit) {
 
-    unless (fork) {
-	exec "X", ":9" or exit 1;
+	my %c = my @c = (
+	   __("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() },
+           __("Change Graphic card") => sub { $o->{card} = cardConfiguration() },
+	   __("Change Resolution") => sub { resolutionsConfiguration($o, 1) },
+	   __("Test again") => sub { $ok = testFinalConfig($o) },
+	   __("Quit") => sub { $quit = 1 },
+        );
+	&{$c{$in->ask_from_list_('', 
+				 _("What do you want to do?"),
+				 [ grep { !ref } @c ])}};
     }
     
-    {
-	local $ENV{DISPLAY} = ":9";
-	my $w = interactive_gtk->new;
-	$w->ask_yesorno("Do you see this message");
-    }
-
     # Success 
-    rewriteInittab(rc & STARTX ? 5 : 3);
+#    rewriteInittab($rc ? 3 : 5) unless $::testing;
 }
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index 976f65d9e..841704332 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -6,6 +6,14 @@ use common qw(:common);
 
 @depths = qw(8 15 16 24 32);
 
+%depths_text = (
+    __("256 colors") => 8,
+    __("32 thousand colors") => 15,
+    __("65 thousand colors") => 16,
+    __("16 millions of colors") => 24,
+    __("4 billions of colors") => 32,
+);
+
 $resolution_wanted = "1024x768";
 @resolutions = qw(640x480 800x600 1024x768 1152x864 1280x1024 1600x1200);
 
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 13b587060..3c70564df 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -178,10 +178,6 @@ sub formatPartitions {
 }
 
 sub findInstallFiles {
-    log::l("reading /usr/lib/rpm/rpmrc");
-    c::rpmReadConfigFiles() or die "can't read rpm config files";
-    log::l("\tdone");
-
     $o->{packages} = pkgs::psUsingDirectory();
     pkgs::getDeps($o->{packages});
 
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
new file mode 100644
index 000000000..f3fabc985
--- /dev/null
+++ b/perl-install/install_steps_interactive.pm
@@ -0,0 +1,128 @@
+package install_steps_interactive;
+
+# heritate from this class and you'll get all made interactivity for same steps.
+# for this you need to provide 
+# - ask_from_listW(o, title, messages, arrayref, default) returns one string of arrayref
+# - ask_many_from_listW(o, title, messages, arrayref, arrayref2) returns one string of arrayref
+#
+# where
+# - o is the object
+# - title is a string
+# - messages is an refarray of strings
+# - default is an optional string (default is in arrayref)
+# - arrayref is an arrayref of strings
+# - arrayref2 contains booleans telling the default state, 
+#
+# ask_from_list and ask_from_list_ are wrappers around ask_from_biglist and ask_from_smalllist
+#
+# ask_from_list_ just translate arrayref before calling ask_from_list and untranslate the result
+#
+# ask_from_listW should handle differently small lists and big ones.
+
+
+use diagnostics;
+use strict;
+use vars qw(@ISA);
+
+@ISA = qw(install_steps);
+
+use common qw(:common);
+use partition_table qw(:types);
+use install_steps;
+use lang;
+use log;
+
+1;
+
+sub errorInStep($$) {
+    my ($o, $err) = @_;
+    $o->ask_warn(_("Error"), [ _("An error occured"), $err ]);
+}
+
+=cut
+sub chooseLanguage($) {
+    my ($o) = @_;
+    lang::text2lang($o->ask_from_list("Language",
+				      __("Which language do you want?"), # the translation may be used for the help
+				      [ lang::list() ]));
+}
+
+sub selectInstallOrUpgrade($) {
+    my ($o) = @_;
+    $o->ask_from_list_(_("Install/Upgrade"), 
+		       _("Is it an install or an updgrade?"),
+		       [ __("Install"), __("Upgrade") ], 
+		       "Install") eq "Upgrade";
+}
+
+sub selectInstallClass($@) {
+    my ($o, @classes) = @_;
+    $o->ask_from_list_(_("Install Class"),
+		       _("What type of user will you have?"),
+		       [ @classes ]);
+}
+
+sub rebootNeeded($) {
+    my ($o) = @_;
+    $o->ask_warn('', _("You need to reboot for the partition table modifications to take place"));
+    $o->SUPER::rebootNeeded;
+}
+
+sub choosePartitionsToFormat($$) {
+    my ($o, $fstab) = @_;
+    my @l = grep { $_->{mntpoint} && (isExt2($_) || isSwap($_)) } @$fstab;
+    my @r = $o->ask_many_from_list('', _("Choose the partitions you want to format"), 
+				   [ map { $_->{mntpoint} } @l ], 
+				   [ map { $_->{notFormatted} } @l ]);
+    for (my $i = 0; $i < @l; $i++) {
+	$l[$i]->{toFormat} = $r[$i];
+    }
+}
+
+sub installPackages {
+    my $o = shift;
+
+    my $old = \&log::ld;
+    local *log::ld = sub { 
+	my $m = shift;
+	if ($m =~ /^starting installing/) {
+	    my $name = first($_[0] =~ m|([^/]*)-.+?-|);
+	    print("installing package $name");
+	} else { goto $old }
+    };    
+    $o->SUPER::installPackages(@_);
+}
+
+sub createBootdisk($) {
+    my ($o) = @_;
+    
+    $o->SUPER::createBootdisk if 
+	$o->{default}->{mkbootdisk} = $o->ask_yesorno('',
+ _("A custom bootdisk provides a way of booting into your Linux system without
+depending on the normal bootloader. This is useful if you don't want to install
+lilo on your system, or another operating system removes lilo, or lilo doesn't
+work with your hardware configuration. A custom bootdisk can also be used with
+the Mandrake rescue image, making it much easier to recover from severe system
+failures. Would you like to create a bootdisk for your system?"));
+}
+
+sub setupBootloader($) {
+    my ($o) = @_;
+
+    my $where = $o->ask_from_list(_("Lilo Installation"), _("Where do you want to install the bootloader?"), [ _("First sector of drive"), _("First sector of boot partition") ]);
+    $o->{default}->{bootloader}->{onmbr} = $where eq _("First sector of drive");
+    
+    $o->SUPER::setupBootloader;
+}
+=cut
+sub exitInstall { 
+    my ($o) = @_;
+    $o->ask_warn('',
+_"Congratulations, installation is complete.
+Remove the boot media and press return to reboot.
+For information on fixes which are available for this release of Linux Mandrake,
+consult the Errata available from http://www.linux-mandrake.com/.
+Information on configuring your system is available in the post
+install chapter of the Official Linux Mandrake User's Guide.");
+}
+
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 935766470..e83e161cb 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -20,7 +20,7 @@ sub ask_from_listW {
 	my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
 	gtkadd($w->{window},
 	       gtkpack(create_box_with_title($o, @$messages),
-		       gtkadd(create_hbox(),
+		       gtkadd((@$l < 3 ? create_hbox() : create_vbox()),
 			      map {
 				  my $b = new Gtk::Button($_);
 				  $b->signal_connect(clicked => [ $f, $_ ]);
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index ff34324b0..ebce6f49d 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -6,8 +6,8 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment create_box_with_title) ],
-    wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy) ],
+    helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title) ],
+    wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy gtkset_mousecursor gtkset_background) ],
     ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list ) ],
 );
 $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
@@ -118,6 +118,33 @@ sub gtkadd($@) {
     $w
 }
 
+sub gtkset_mousecursor($) {
+    my ($type) = @_;
+    Gtk->init;
+
+    my $root = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
+    $root->set_cursor(Gtk::Gdk::Cursor->new($type));
+}
+
+sub gtkset_background($$$) {
+    my ($r, $g, $b) = @_;
+
+    Gtk->init;
+    my $root = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
+    my $gc = Gtk::Gdk::GC->new($root);
+
+    my $color = bless {}, 'Gtk::Gdk::Color';
+    $color->red  ($r << 8);
+    $color->green($g << 8);
+    $color->blue ($b << 8);
+    $color = $root->get_colormap->color_alloc($color);
+    $gc->set_foreground($color);
+    $root->set_background($color);
+    
+    my ($h, $w) = $root->get_size;
+    
+    $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
+}
 
 
 
@@ -139,7 +166,7 @@ sub create_okcancel($;$$) {
 sub create_box_with_title($@) {
     my $o = shift;
     $o->{box} = gtkpack_(new Gtk::VBox(0,0),
-			 0, map({ new Gtk::Label("  $_  ") } @_),
+			 map({ 0, $_ } @_),
 			 0, new Gtk::HSeparator,
 		       )
 }
@@ -204,6 +231,11 @@ sub create_hbox {
     $w->set_layout(-spread);
     $w;
 }
+sub create_vbox {
+    my $w = new Gtk::VButtonBox;
+    $w->set_layout(-spread);
+    $w;
+}
 
 
 sub _create_window($$) {
@@ -291,7 +323,7 @@ sub _ask_from_list($$$$) {
     gtkadd($o->{window}, 
 	   gtkpack($o->create_box_with_title(@$messages), 
 		   @widgets > 15 ? 
-		     gtkset_usize(createScrolledWindow($list), 0, 300) : 
+		     gtkset_usize(createScrolledWindow($list), 200, 300) : 
 		     $list));
     $widgets[$def]->grab_focus;
 }
@@ -329,3 +361,5 @@ sub _ask_okcancel($@) {
 #    $w->set_alignment(!/W/i, !/N/i);
 #    $w
 #}
+
+
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index f56e43cee..0ad16d1b0 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -221,6 +221,10 @@ sub init_db {
     c::rpmErrorSetCallback($fd);
 #    c::rpmSetVeryVerbose();
     
+    log::l("reading /usr/lib/rpm/rpmrc");
+    c::rpmReadConfigFiles() or die "can't read rpm config files";
+    log::l("\tdone");
+
     $isUpgrade ? c::rpmdbRebuild($prefix) : c::rpmdbInit($prefix, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString();
 }
 
@@ -238,6 +242,8 @@ sub getHeader($) {
 sub install {
     my ($prefix, $toInstall, $isUpgrade, $force) = @_;
 
+    c::rpmReadConfigFiles() or die "can't read rpm config files";
+
     my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
     log::l("opened rpm database");
 
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
index fe50ddd12..6239e6075 100644
--- a/perl-install/resize_fat/main.pm
+++ b/perl-install/resize_fat/main.pm
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 # DiskDrake
-# Copyright (C) 1999 MandrakeSoft
+# Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -17,6 +17,8 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
+# This is mainly a perl rewrite of the work of Andrew Clausen (libresize)
+
 package resize_fat::main;
 
 use diagnostics;