no_comment

5 files changed, 90 insertions, 84 deletions

diff --git a/perl-install/Makefile b/perl-install/Makefile
index 434a06bcb..fbfdc0dfd 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -27,9 +27,6 @@ test_pms: verify_c
 	./perl2fcalls -excludec -excluderesize_fat::c_rewritten install2 standalone/keyboarddrake standalone/XFdrake
 	for i in install2 install_steps_*.pm; do perl -cw -I. $$i; done
 
-test_all: test_pms
-	for i in $(PMS); do perl -cw -I. $$i; done
-
 verify_c:
 	./verify_c $(PMS)
 
diff --git a/perl-install/install_interactive.pm b/perl-install/install_interactive.pm
index 074f8aff5..d60e922cb 100644
--- a/perl-install/install_interactive.pm
+++ b/perl-install/install_interactive.pm
@@ -273,7 +273,7 @@ sub setup_thiskind {
     }
     @l = map { $_->{description} } @l;
     while (1) {
-	my ($msg_type) = $type =~ /(.*)|/;
+	(my $msg_type = $type) =~ s/\|.*//;
 	my $msg = @l ?
 	  [ _("Found %s %s interfaces", join(", ", @l), $msg_type),
 	    _("Do you have another one?") ] :
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 00c452066..6e70ff99d 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -249,7 +249,7 @@ a percentage of %d%% will install as many packages as possible.", $percentage, $
 sub choosePackagesTree {
     my ($o, $packages, $compss) = @_;
 
-    my ($curr, $info_widget, $w_size, $go, $idle, $flat, $auto_deps);
+    my ($curr, $parent, $info_widget, $w_size, $go, $idle, $flat, $auto_deps);
     my (%wtree, %ptree);
 
     my $w = my_gtk->new('');
@@ -283,22 +283,28 @@ sub choosePackagesTree {
     my $pix_base     = [ gtkcreate_xpm($w->{window}, "$ENV{SHARE_PATH}/rpm-base.xpm") ];
     my $pix_selected = [ gtkcreate_xpm($w->{window}, "$ENV{SHARE_PATH}/rpm-selected.xpm") ];
     my $pix_unselect = [ gtkcreate_xpm($w->{window}, "$ENV{SHARE_PATH}/rpm-unselected.xpm") ];
+    my $pix_semisele = [ gtkcreate_xpm($w->{window}, "$ENV{SHARE_PATH}/rpm-semiselected.xpm") ];
     my $pix_installed= [ gtkcreate_xpm($w->{window}, "$ENV{SHARE_PATH}/rpm-installed.xpm") ];
 
-    my $parent; $parent = sub {
+    my $add_parent; $add_parent = sub {
 	if (my $w = $wtree{$_[0]}) { return $w }
 	my $s; foreach (split '/', $_[0]) {
-	    $wtree{"$s/$_"} ||= 
-	      $tree->insert_node($s ? $parent->($s) : undef, undef, [$_, '', ''], 5, (undef) x 4, 0, 0);
-	    $s = "$s/$_";
+	    my $s2 = $s ? "$s/$_" : $_;
+	    $wtree{$s2} ||= do {	     
+		my $n = $tree->insert_node($s ? $add_parent->($s) : undef, undef, [$_, '', ''], 5, (undef) x 4, 0, 0);
+		$n;
+	    };
+	    $s = $s2;
 	}
+	$tree->node_set_pixmap($wtree{$s}, 1, $pix_semisele->[0], $pix_semisele->[1]);
 	$wtree{$s};
     };
     my $add_node = sub {
 	my ($leaf, $root) = @_;
-	my $node = $tree->insert_node($parent->($root), undef, [$leaf, '', ''], 5, (undef) x 4, 1, 0);
 	my $p = $packages->[0]{$leaf} or return;
 	$p->{medium}{selected} or return;
+	my $node = $tree->insert_node($add_parent->($root), 
+				      undef, [$leaf, '', ''], 5, (undef) x 4, 1, 0);
 	my $pix = pkgs::packageFlagBase($p) ? $pix_base : pkgs::packageFlagSelected($p) ? $pix_selected : pkgs::packageFlagInstalled($p) ? $pix_installed : $pix_unselect;
 	$tree->node_set_pixmap($node, 1, $pix->[0], $pix->[1]);
 	push @{$ptree{$leaf}}, $node;
@@ -337,7 +343,6 @@ sub choosePackagesTree {
     }
     $toolbar->set_style("icons");
 
-
     my $display_info = sub {
 	my $p = $packages->[0]{$curr} or return gtktext_insert($info_widget, '');
 	pkgs::extractHeaders($o->{prefix}, [$p], $p->{medium});
@@ -362,57 +367,79 @@ sub choosePackagesTree {
 		       pkgs::correctSize($size / sqr(1024)),
 		       install_any::getAvailableSpace($o) / sqr(1024)));
     };
+    my $select = sub {
+	my %l;
+	my $isSelection = !pkgs::packageFlagSelected($_[0]);
+	foreach (@_) {
+	    pkgs::togglePackageSelection($packages, $_, my $l = {});
+	    @l{keys %$l} = ();
+	}
+	if (my @l = keys %l) {
+	    #- check for size before trying to select.
+	    my $size = pkgs::selectedSize($packages);
+	    foreach (@l) {
+		my $p = $packages->[0]{$_};
+		pkgs::packageFlagSelected($p) or $size += pkgs::packageSize($p);
+	    }
+	    if (pkgs::correctSize($size / sqr(1024)) > install_any::getAvailableSpace($o) / sqr(1024)) {
+		return $o->ask_warn('', _("You can't select this package as there is not enough space left to install it"));
+	    }
+
+	    @l > @_ && !$auto_deps and $o->ask_okcancel('', [ _("The following packages are going to be installed/removed"), join(", ", sort @l) ], 1) || return;
+	    $isSelection ? pkgs::selectPackage($packages, $_) : pkgs::unselectPackage($packages, $_) foreach @_;
+	    foreach (@l) {
+		my $p = $packages->[0]{$_};
+		my $pix = pkgs::packageFlagSelected($p) ? $pix_selected : $pix_unselect;
+		$tree->node_set_pixmap($_, 1, $pix->[0], $pix->[1]) foreach @{$ptree{$_}};
+	    }
+	    &$update_size;
+	} else {
+	    $o->ask_warn('', _("You can't select/unselect this package"));
+	}
+    };
+    my $children = sub { map { $packages->[0]{($tree->node_get_pixtext($_, 0))[0]} } gtkctree_children($_[0]) };
     my $toggle_ = sub {
-	if (ref $curr) {
+	if (ref $curr && ! $_[0]) {
 	    $tree->toggle_expansion($curr);
 	} else {
-	    my $p = $packages->[0]{$curr} or return;
-	    if (pkgs::packageFlagBase($p)) {
-		return $o->ask_warn('', _("This is a mandatory package, it can't be unselected"));
-	    } elsif (pkgs::packageFlagInstalled($p)) {
-		return $o->ask_warn('', _("You can't unselect this package. It is already installed"));
-	    } elsif (pkgs::packageFlagUpgrade($p)) {
-		if ($::expert) {
-		    if (pkgs::packageFlagSelected($p)) {
-			$o->ask_yesorno('', _("This package must be upgraded\nAre you sure you want to deselect it?")) or return;
+	    if (ref $curr) {
+		my @l = grep { !pkgs::packageFlagBase($_) } $children->($curr) or return;
+		my @unsel = grep { !pkgs::packageFlagSelected($_) } @l;
+		my @p = @unsel ?
+		  @unsel : # not all is selected, select all
+		    @l;
+		$select->(@p);
+		$parent = $curr;
+	    } else {
+		my $p = $packages->[0]{$curr} or return;
+		if (pkgs::packageFlagBase($p)) {
+		    return $o->ask_warn('', _("This is a mandatory package, it can't be unselected"));
+		} elsif (pkgs::packageFlagInstalled($p)) {
+		    return $o->ask_warn('', _("You can't unselect this package. It is already installed"));
+		} elsif (pkgs::packageFlagUpgrade($p)) {
+		    if ($::expert) {
+			if (pkgs::packageFlagSelected($p)) {
+			    $o->ask_yesorno('', _("This package must be upgraded\nAre you sure you want to deselect it?")) or return;
+			}
+		    } else {
+			return $o->ask_warn('', _("You can't unselect this package. It must be upgraded"));
 		    }
-		} else {
-		    return $o->ask_warn('', _("You can't unselect this package. It must be upgraded"));
-		}
-	    }
-
-	    pkgs::togglePackageSelection($packages, $p, my $l = {});
-	    if (my @l = grep { $l->{$_} } keys %$l) {
-		#- check for size before trying to select.
-		my $size = pkgs::selectedSize($packages);
-		foreach (@l) {
-		    my $p = $packages->[0]{$_};
-		    pkgs::packageFlagSelected($p) or $size += pkgs::packageSize($p);
-		}
-		if (pkgs::correctSize($size / sqr(1024)) > install_any::getAvailableSpace($o) / sqr(1024)) {
-		    return $o->ask_warn('', _("You can't select this package as there is not enough space left to install it"));
 		}
-
-		@l > 1 && !$auto_deps and $o->ask_okcancel('', [ _("The following packages are going to be installed/removed"), join(", ", sort @l) ], 1) || return;
-		pkgs::togglePackageSelection($packages, $p);
-		foreach (@l) {
-		    my $p = $packages->[0]{$_};
-		    my $pix = pkgs::packageFlagSelected($p) ? $pix_selected : $pix_unselect;
-		    $tree->node_set_pixmap($_, 1, $pix->[0], $pix->[1]) foreach @{$ptree{$_}};
-		}
-		&$update_size;
-	    } else {
-		$o->ask_warn('', _("You can't select/unselect this package"));
+		$select->($p);
 	    }
+	    my @l = $children->($parent);
+	    my $nb = grep { pkgs::packageFlagSelected($_) } @l;
+	    my $pix = $nb==0 ? $pix_unselect : $nb<@l ? $pix_semisele : $pix_selected;
+	    $tree->node_set_pixmap($parent, 1, $pix->[0], $pix->[1]);
 	}
     };
     my $toggle = sub { &$toggle_; gtkset_mousecursor_normal() };
 
-    $tree->signal_connect(button_press_event => sub { &$toggle if $_[1]{type} =~ /^2/ });
+    $tree->signal_connect(button_press_event => sub { $toggle->(0) if $_[1]{type} =~ /^2/ });
     $tree->signal_connect(key_press_event => sub {
         my ($w, $e) = @_;
 	my $c = chr($e->{keyval} & 0xff);
-	&$toggle if $e->{keyval} >= 0x100 ? $c eq "\r" || $c eq "\x8d" : $c eq ' ';
+	$toggle->(0) if $e->{keyval} >= 0x100 ? $c eq "\r" || $c eq "\x8d" : $c eq ' ';
 	1;
     });
     $tree->signal_connect(tree_select_row => sub {
@@ -420,11 +447,12 @@ sub choosePackagesTree {
 
 	if ($_[1]->row->is_leaf) {
 	    ($curr) = $tree->node_get_pixtext($_[1], 0);
+	    $parent = $_[1]->row->parent;
 	    $idle = Gtk->timeout_add(100, $display_info);
 	} else {
 	    $curr = $_[1];
 	}
-	&$toggle if $_[2] == 1;
+	$toggle->(1) if $_[2] == 1;
     });
     &$update_size;
     $w->main;
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index c332f9559..2e9e763ad 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -364,6 +364,5 @@ sub kill {
 	my $w = pop @interactive::objects;
 	$w->destroy;
     }
-    @my_gtk::grabbed = ();
     $o->{before_killing} = @interactive::objects;
 }
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 6c94f4ca8..defcb412a 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -5,12 +5,12 @@ package my_gtk;
 
 use diagnostics;
 use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border @grabbed);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
     helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title create_treeitem) ],
-    wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkpack__ gtkappend gtkadd gtktext_insert gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy gtkset_mousecursor gtkset_mousecursor_normal gtkset_mousecursor_wait gtkset_background gtkset_default_fontset gtkxpm gtkcreate_xpm) ],
+    wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkpack__ gtkappend gtkadd gtktext_insert gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy gtkset_mousecursor gtkset_mousecursor_normal gtkset_mousecursor_wait gtkset_background gtkset_default_fontset gtkctree_children gtkxpm gtkcreate_xpm) ],
     ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list ask_file) ],
 );
 $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
@@ -39,9 +39,8 @@ sub new {
     while (my $e = shift @tempory::objects) { $e->destroy }
     push @interactive::objects, $o unless $opts{no_interactive_objects};
 
-    top(@grabbed)->grab_remove if @grabbed;
-    push(@grabbed, $o->{rwindow}), $o->{rwindow}->grab_add if $my_gtk::grab || $o->{grab};
-
+    $o->{rwindow}->set_modal(1) if $my_gtk::grab || $o->{grab};
+    print "modal############################################################\n" if $my_gtk::grab || $o->{grab};
     $o;
 }
 sub main($;$) {
@@ -63,8 +62,6 @@ sub show($) {
 }
 sub destroy($) {
     my ($o) = @_;
-    (pop @grabbed)->grab_remove if @grabbed;
-    top(@grabbed)->grab_add if @grabbed;
     $o->{rwindow}->destroy;
     gtkset_mousecursor_wait();
     flush();
@@ -178,7 +175,7 @@ sub gtkset_background {
     $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
 }
 
-sub gtkset_default_fontset($) {
+sub gtkset_default_fontset {
     my ($fontset) = @_;
 
     my $style = Gtk::Widget->get_default_style;
@@ -187,6 +184,15 @@ sub gtkset_default_fontset($) {
     Gtk::Widget->set_default_style($style);
 }
 
+sub gtkctree_children {
+    my ($node) = @_;
+    my @l;
+    for (my $p = $node->row->children; $p; $p = $p->row->sibling) {
+	push @l, $p;
+    }
+    @l;
+}
+
 sub gtkcreate_xpm { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm($w->window, $w->style->bg('normal'), @_) }
 sub xpm_d { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm_d($w->window, undef, @_) }
 sub gtkxpm { new Gtk::Pixmap(gtkcreate_xpm(@_)) }
@@ -300,31 +306,7 @@ sub _create_window($$) {
     my $w = new Gtk::Window;
     my $f = new Gtk::Frame(undef);
     $w->set_name("Title");
-
-    if ($::isStandalone || $o->{no_border} || 1) { # hack
-	gtkadd($w, $f);
-    } else {
-	my $t = new Gtk::Table(0, 0, 0);
-
-	my $new = sub {
-	    my $w = new Gtk::DrawingArea;
-	    $w->set_usize($border, $border);
-	    $w->set_events(['exposure_mask']);
-	    $w->signal_connect_after(expose_event =>
-		sub { $w->window->draw_rectangle($w->style->black_gc, 1, 0, 0, @{$w->allocation}[2,3]); 1 }
-	    );
-	    $w->show;
-	    $w;
-	};
-
-	$t->attach(&$new(), 0, 1, 0, 3, [],              , ["expand","fill"], 0, 0);
-	$t->attach(&$new(), 1, 2, 0, 1, ["expand","fill"], [],                0, 0);
-	$t->attach($f,      1, 2, 1, 2, ["expand","fill"], ["expand","fill"], 0, 0);
-	$t->attach(&$new(), 1, 2, 2, 3, ["expand","fill"], [],                0, 0);
-	$t->attach(&$new(), 2, 3, 0, 3, [],                ["expand","fill"], 0, 0);
-
-	gtkadd($w, $t);
-    }
+    gtkadd($w, $f);
 
     $w->set_title($title);