diff options
Diffstat (limited to 'perl-install/interactive_gtk.pm')
| -rw-r--r-- | perl-install/interactive_gtk.pm | 190 |
1 files changed, 190 insertions, 0 deletions
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index 710ca88a3..77923070e 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -503,6 +503,196 @@ sub ask_from_entries_refW { } +sub ask_browse_tree_info_refW { + my ($o, $common) = @_; + my ($curr, $parent, $info_widget, $w_size, $prev_label, $go, $idle); + my (%wtree, %ptree, %pix); + + my $w = my_gtk->new($common->{title}); + my $details = new Gtk::VBox(0,0); + my $tree = Gtk::CTree->new(3, 0); + $tree->set_selection_mode('browse'); + $tree->set_column_width(0, 200); + $tree->set_column_auto_resize($_, 1) foreach 1..2; + + gtkadd($w->{window}, + gtkpack_(new Gtk::VBox(0,5), + 0, $common->{message}, + 1, gtkpack(new Gtk::HBox(0,0), + createScrolledWindow($tree), + gtkadd(gtkset_usize(new Gtk::Frame(_("Info")), $::windowwidth - 490, 0), + createScrolledWindow($info_widget = new Gtk::Text), + )), + 0, my $l = new Gtk::HBox(0,15), + 0, gtkpack(new Gtk::HBox(0,10), + $go = gtksignal_connect(new Gtk::Button($common->{ok}), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }), + $common->{cancel} ? (gtksignal_connect(new Gtk::Button($common->{cancel}), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit })) : (), + ) + )); + gtkpack__($l, my $toolbar = new Gtk::Toolbar('horizontal', 'icons')); + if ($common->{auto_deps}) { + gtkpack__($l, gtksignal_connect(gtkset_active(new Gtk::CheckButton($common->{auto_deps}), $common->{state}{auto_deps}), clicked => sub { invbool \$common->{state}{auto_deps} })); + } + $l->pack_end($w_size = new Gtk::Label($prev_label = $common->{state}{status_label}), 0, 1, 20); + + $w->{window}->set_usize(map { $_ - 2 * $my_gtk::border - 4 } $::windowwidth, $::windowheight); + $go->grab_focus; + $w->{rwindow}->show_all; + + my $update_size = sub { + my $new_label = $common->{get_status}(); + $prev_label ne $new_label and $w_size->set($prev_label = $new_label); + }; + + my $set_node_state_flat = sub { + my ($node, $state) = @_; + unless ($pix{$state}) { + foreach ("$ENV{SHARE_PATH}/$state.png", "$ENV{SHARE_PATH}/rpm-$state.png") { + if (-e $_) { + $pix{$state} = [ gtkcreate_png($_) ]; + last; + } + } + $pix{$state} or die "unable to find a pixmap for state $state"; + } + $tree->node_set_pixmap($node, 1, $pix{$state}[0], $pix{$state}[1]); + }; + my $set_node_state_tree; $set_node_state_tree = sub { + my ($node, $state) = @_; + unless ($pix{$state}) { + foreach ("$ENV{SHARE_PATH}/$state.png", "$ENV{SHARE_PATH}/rpm-$state.png") { + if (-e $_) { + $pix{$state} = [ gtkcreate_png($_) ]; + last; + } + } + $pix{$state} or die "unable to find a pixmap for state $state"; + } + if ($node->{state} ne $state) { + if ($node->row->is_leaf) { + my $parent = $node->row->parent; + my $stats = $parent->{state_stats} ||= {}; --$stats->{$node->{state}}; ++$stats->{$state}; + my @list = grep { $stats->{$_} > 0 } keys %$stats; + my $new_state = @list == 1 ? $list[0] : 'semiselected'; + $parent->{state} ne $new_state and $set_node_state_tree->($parent, $new_state); + } + $tree->node_set_pixmap($node, 1, $pix{$state}[0], $pix{$state}[1]); + $node->{state} = $state; #- hack to to get this features efficiently. + } + }; + my $set_node_state = $common->{state}{flat} ? $set_node_state_flat : $set_node_state_tree; + + my $set_leaf_state = sub { + my ($leaf, $state) = @_; + $set_node_state->($_, $state) foreach @{$ptree{$leaf}}; + }; + my $add_parent; $add_parent = sub { + my ($root, $state) = @_; + $root or return undef; + if (my $w = $wtree{$root}) { return $w } + my $s; foreach (split '\|', $root) { + my $s2 = $s ? "$s|$_" : $_; + $wtree{$s2} ||= do { + my $n = $tree->insert_node($s ? $add_parent->($s, $state) : undef, undef, [$_, '', ''], 5, (undef) x 4, 0, 0); + $n; + }; + $s = $s2; + } + $set_node_state->($wtree{$s}, $state); #- use this state by default as tree is building. + $wtree{$s}; + }; + my $add_node = sub { + my ($leaf, $root) = @_; + my $state = $common->{node_state}($leaf) or return; + my $node = $tree->insert_node($add_parent->($root, $state), undef, [$leaf, '', ''], 5, (undef) x 4, 1, 0); + $set_node_state->($node, $state); + push @{$ptree{$leaf}}, $node; + }; + my $add_nodes = sub { + foreach (values %ptree) { + delete $_->{state} foreach @$_; + } + foreach (values %wtree) { + delete $_->{state}; + delete $_->{state_stats}; + } + %ptree = %wtree = (); + + $tree->freeze; + while (1) { $tree->remove_node($tree->node_nth(0) || last) } + + $common->{state}{flat} = $_[0]; + $set_node_state = $common->{state}{flat} ? $set_node_state_flat : $set_node_state_tree; + $common->{build_tree}($add_node, $common->{state}{flat}); + + $tree->thaw; + &$update_size; + }; + $add_nodes->($common->{state}{flat}); + + my @toolbar = (ftout => [ _("Expand Tree") , sub { $tree->expand_recursive(undef) } ], + ftin => [ _("Collapse Tree") , sub { $tree->collapse_recursive(undef) } ], + reload => [ _("Toggle between flat and group sorted"), sub { $add_nodes->(!$common->{state}{flat}) } ]); + foreach (@{$common->{icons} || []}) { + push @toolbar, ( $_->{icon} => [ $_->{help}, sub { + if ($_->{code}) { + my $w = $_->{wait_msg} && $o->wait_message('', $_->{wait_msg}); + $add_nodes->($common->{state}{flat}); + } + } ]); + } + my %toolbar = @toolbar; + $toolbar->set_button_relief("none"); + foreach (grep_index { $::i % 2 == 0 } @toolbar) { + gtksignal_connect($toolbar->append_item(undef, $toolbar{$_}[0], undef, gtkpng("$ENV{SHARE_PATH}/$_.png")), + clicked => $toolbar{$_}[1]); + } + $toolbar->set_style("icons"); + + my $display_info = sub { gtktext_insert($info_widget, $common->{get_info}($curr)); 0 }; + my $children = sub { map { ($tree->node_get_pixtext($_, 0))[0] } gtkctree_children($_[0]) }; + my $toggle = sub { + if (ref $curr && ! $_[0]) { + $tree->toggle_expansion($curr); + } else { + if (ref $curr) { + my @l = $common->{grep_allowed_to_toggle}($children->($curr)) or return; + my @unsel = $common->{grep_unselected}(@l); + my @p = @unsel ? + @unsel : # not all is selected, select all + @l; + $common->{toggle_nodes}($set_leaf_state, @p); + &$update_size; + $parent = $curr; + } else { + $common->{check_interactive_to_toggle}($curr) and $common->{toggle_nodes}($set_leaf_state, $curr); + &$update_size; + } + } + }; + + $tree->signal_connect(key_press_event => sub { + my ($w, $e) = @_; + my $c = chr($e->{keyval} & 0xff); + $toggle->(0) if $e->{keyval} >= 0x100 ? $c eq "\r" || $c eq "\x8d" : $c eq ' '; + 1; + }); + $tree->signal_connect(tree_select_row => sub { + Gtk->timeout_remove($idle) if $idle; + + 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->(1) if $_[2] == 1; + }); + &$update_size; + $w->main; +} + sub wait_messageW($$$) { my ($o, $title, $messages) = @_; |