summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile3
-rw-r--r--perl-install/install_interactive.pm2
-rw-r--r--perl-install/install_steps_gtk.pm120
-rw-r--r--perl-install/interactive_gtk.pm1
-rw-r--r--perl-install/my_gtk.pm48
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);