From 9cb5cb2a00640129fe459915f8a58113317db5fa Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Tue, 22 Feb 2000 10:26:55 +0000 Subject: no_comment --- perl-install/install2.pm | 2 -- perl-install/install_steps_interactive.pm | 2 +- perl-install/interactive.pm | 20 +++++++++++ perl-install/interactive_gtk.pm | 58 +++++++++++++++++++++++++++++++ perl-install/interactive_newt.pm | 5 --- 5 files changed, 79 insertions(+), 8 deletions(-) diff --git a/perl-install/install2.pm b/perl-install/install2.pm index e22e02b9d..1be42e390 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -592,8 +592,6 @@ sub main { #- needed very early for install_steps_gtk eval { ($o->{mouse}, $o->{wacom}) = mouse::detect() } unless $o->{nomouseprobe} || $o->{mouse}; - print %{$o->{mouse}}, "\n"; - $::o = $o = $::auto_install ? install_steps_auto_install->new($o) : $o->{interactive} eq "stdio" ? diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 261fc0d47..2de1d75ce 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -546,7 +546,7 @@ sub timeConfig { require timezone; $o->{timezone}{timezone} ||= timezone::bestTimezone(lang::lang2text($o->{lang})); - $o->{timezone}{timezone} = $o->ask_from_list('', _("Which is your timezone?"), [ timezone::getTimeZones($::g_auto_install ? '' : $o->{prefix}) ], $o->{timezone}{timezone}); + $o->{timezone}{timezone} = $o->ask_from_treelist('', _("Which is your timezone?"), '/', [ timezone::getTimeZones($::g_auto_install ? '' : $o->{prefix}) ], $o->{timezone}{timezone}); $o->{timezone}{UTC} = $o->ask_yesorno('', _("Is your hardware clock set to GMT?"), $o->{timezone}{UTC}) if $::expert || $clicked; install_steps::timeConfig($o,$f); } diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index ac8ced5a2..5d4254cc1 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -112,6 +112,19 @@ sub ask_from_list2($$$$;$) { $o->ask_from_listW($title, [ deref($message) ], $l, $def || $l->[0]); } + +sub ask_from_treelist { + my ($o, $title, $message, $separator, $l, $def) = @_; + $o->ask_from_treelistW($title, [ deref($message) ], $separator, [ sort @$l ], $def || $l->[0]); +} +#- defaults to simple ask_from_list +sub ask_from_treelistW($$$$;$) { + my ($o, $title, $message, $separator, $l, $def) = @_; + $o->ask_from_listW($title, [ deref($message) ], $l, $def); +} + + + sub ask_many_from_list_ref { my ($o, $title, $message, $l, $val) = @_; return 1 if @$l == 0; @@ -122,6 +135,13 @@ sub ask_many_from_list_with_help_ref { return 1 if @$l == 0; $o->ask_many_from_list_with_help_refW($title, [ deref($message) ], $l, $help, $val); } + +#- defaults to without help +sub ask_many_from_list_with_help_refW { + my ($o, $title, $messages, $list, $help, $val) = @_; + $o->ask_many_from_list_refW($title, $messages, $list, $val); +} + sub ask_many_from_list { my ($o, $title, $message, $l, $def) = @_; diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index 4b99d47d0..840dbdf95 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -53,6 +53,64 @@ sub ask_from_listW { $r or die "ask_from_list cancel"; } +sub ask_from_treelist { + my ($o, $title, $messages, $separator, $l, $def) = @_; + my $sep = quotemeta $separator; + my $w = my_gtk->new($title); + my $tree = Gtk::CTree->new(1, 0); + + my %wtree; + my $parent; $parent = sub { + if (my $w = $wtree{"$_[0]$separator"}) { return $w } + my $s; + foreach (split $sep, $_[0]) { + $wtree{"$s$_$separator"} ||= + $tree->insert_node($s ? $parent->($s) : undef, undef, [$_], 2, (undef) x 4, 0, 0); + $s .= "$_$separator"; + } + $wtree{$s}; + }; + my ($root, $leaf, $wdef, $ndef); + foreach (@$l) { + ($root, $leaf) = /(.*)$sep(.+)/o or ($root, $leaf) = ('', $_); + my $node = $tree->insert_node($parent->($root), undef, [$leaf], 2, (undef) x 4, 1, 0); + + if ($def eq $_) { + $wdef = $node; + my $s; $tree->expand($wtree{$s .= "$_$separator"}) foreach split $sep, $root; + foreach (1 .. @$l) { + $tree->node_nth($_) == $node and $ndef = $_, last; + } + } + } + undef %wtree; + + my $curr; + my $leave = sub { + $curr->row->is_leaf or return; + my @l; for (; $curr; $curr = $curr->row->parent) { + unshift @l, first $tree->node_get_pixtext($curr, 0); + } + $w->{retval} = join $separator, @l; + Gtk->main_quit; + }; + gtkadd($w->{window}, + gtkpack_(new Gtk::VBox(0,0), + 1, gtkset_usize(createScrolledWindow($tree), 200, 280), + 0, $w->create_okcancel)); + $tree->set_selection_mode('browse'); + $tree->signal_connect(tree_select_row => sub { $curr = $_[1] }); + $tree->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ }); + + $tree->focus_row($ndef) if $ndef; + $tree->select($wdef) if $wdef; + $tree->node_moveto($wdef, 0, 0.5, 0) if $wdef; + + $tree->grab_focus; + $w->{window}->show_all; + $w->main or die "ask_from_list cancel"; +} + sub ask_many_from_list_refW { my ($o, $title, $messages, $list, $val) = @_; ask_many_from_list_with_help_refW($o, $title, $messages, $list, undef, $val) diff --git a/perl-install/interactive_newt.pm b/perl-install/interactive_newt.pm index 3a00a36b0..09163b07c 100644 --- a/perl-install/interactive_newt.pm +++ b/perl-install/interactive_newt.pm @@ -78,11 +78,6 @@ sub ask_from_listW { } } -sub ask_many_from_list_with_help_refW { - my ($o, $title, $messages, $list, $help, $val) = @_; - ask_many_from_list_refW($o, $title, $messages, $list, $val); -} - sub ask_many_from_list_refW { my ($o, $title, $messages, $list, $val) = @_; my $height = min(int @$list, 18); -- cgit v1.2.1