diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/Xconfigurator.pm | 7 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 7 | ||||
| -rw-r--r-- | perl-install/interactive.pm | 199 | ||||
| -rw-r--r-- | perl-install/interactive_gtk.pm | 353 | ||||
| -rw-r--r-- | perl-install/my_gtk.pm | 91 | ||||
| -rw-r--r-- | perl-install/network.pm | 20 | ||||
| -rw-r--r-- | perl-install/printerdrake.pm | 11 |
7 files changed, 283 insertions, 405 deletions
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm index 786bc032d..925749ead 100644 --- a/perl-install/Xconfigurator.pm +++ b/perl-install/Xconfigurator.pm @@ -362,7 +362,7 @@ sub monitorConfiguration(;$$) { add2hash($monitor, { type => $in->ask_from_treelist(_("Monitor"), _("Choose a monitor"), '|', ['Custom', keys %monitors], 'Generic|' . translate($default_monitor)) }) unless $monitor->{type}; if ($monitor->{type} eq 'Custom') { - $in->ask_from_entries_ref('', + $in->ask_from_entries_refH('', _("The two critical parameters are the vertical refresh rate, which is the rate at which the whole screen is refreshed, and most importantly the horizontal sync rate, which is the rate at which scanlines are displayed. @@ -370,9 +370,8 @@ sync rate, which is the rate at which scanlines are displayed. It is VERY IMPORTANT that you do not specify a monitor type with a sync range that is beyond the capabilities of your monitor: you may damage your monitor. If in doubt, choose a conservative setting."), - [ _("Horizontal refresh rate"), _("Vertical refresh rate") ], - [ { val => \$monitor->{hsyncrange}, list => \@hsyncranges }, - { val => \$monitor->{vsyncrange}, list => \@vsyncranges }, ]); + [ { val => \$monitor->{hsyncrange}, list => \@hsyncranges, label => _("Horizontal refresh rate") }, + { val => \$monitor->{vsyncrange}, list => \@vsyncranges, label => _("Vertical refresh rate") }]); } else { add2hash($monitor, $monitors{$monitor->{type}}); } diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 2cdcc6bb7..eb57552d2 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -772,11 +772,10 @@ _("Use NIS") => { val => \$nis, type => 'bool', text => _("yellow pages") }, ) or return; $o->{authentication}{NIS} &&= $nis; - $o->ask_from_entries_ref('', + $o->ask_from_entries_refH('', _("Authentification NIS"), - [ _("NIS Domain"), _("NIS Server") ], - [ \ ($o->{netc}{NISDOMAIN} ||= $o->{netc}{DOMAINNAME}), - { val => \$o->{authentication}{NIS}, list => ["broadcast"] }, + [ { label => _("NIS Domain"), val => \ ($o->{netc}{NISDOMAIN} ||= $o->{netc}{DOMAINNAME}) }, + { label => _("NIS Server"), val => \$o->{authentication}{NIS}, list => ["broadcast"] }, ]) if $nis; install_steps::setRootPassword($o); } diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index 1de89e42a..773bce0fa 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -8,10 +8,21 @@ use strict; #-###################################################################################### use common qw(:common :functional); +#- ask_from_entries takes: +#- val => reference to the value +#- label => description +#- icon => icon to put before the description +#- help => tooltip +#- advanced => wether it is shown in by default or only in advanced mode +#- type => +#- bool (with text) +#- range (with min, max) +#- combo (with list, not_edit) +#- list (with list, icon2f (aka icon), separator (aka tree), help can be a hash or a function) + #- 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 many strings of arrayref #- #- where #- - o is the object @@ -26,7 +37,7 @@ use common qw(:common :functional); #- 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. - +#- #-###################################################################################### @@ -71,32 +82,32 @@ sub exit { exit($_[0]) } #-###################################################################################### #- Interactive functions #-###################################################################################### -sub ask_warn($$$) { +sub ask_warn { my ($o, $title, $message) = @_; - ask_from_list2($o, $title, $message, [ _("Ok") ]); + ask_from_list_no_check($o, $title, $message, [ _("Ok") ]); } -sub ask_yesorno($$$;$) { - my ($o, $title, $message, $def) = @_; - ask_from_list_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "Yes" : "No") eq "Yes"; +sub ask_yesorno { + my ($o, $title, $message, $def, $help) = @_; + ask_from_list_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "Yes" : "No", $help) eq "Yes"; } -sub ask_okcancel($$$;$) { - my ($o, $title, $message, $def) = @_; - ask_from_list_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Ok" : "Cancel") eq "Ok"; +sub ask_okcancel { + my ($o, $title, $message, $def, $help) = @_; + ask_from_list_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Ok" : "Cancel", $help) eq "Ok"; } sub ask_from_list_ { - my ($o, $title, $message, $l, $def) = @_; - ask_from_listf($o, $title, $message, sub { translate($_[0]) }, $l, $def); + my ($o, $title, $message, $l, $def, $help) = @_; + ask_from_listf($o, $title, $message, sub { translate($_[0]) }, $l, $def, $help); } sub ask_from_listf_ { - my ($o, $title, $message, $f, $l, $def) = @_; - ask_from_listf($o, $title, $message, sub { translate($f->(@_)) }, $l, $def); + my ($o, $title, $message, $f, $l, $def, $help) = @_; + ask_from_listf($o, $title, $message, sub { translate($f->(@_)) }, $l, $def, $help); } sub ask_from_listf { - my ($o, $title, $message, $f, $l, $def) = @_; + my ($o, $title, $message, $f, $l, $def, $help) = @_; my $def2; my (@l,%l); my $i = 0; foreach (@$l) { my $v = $f->($_, $i++); @@ -105,58 +116,28 @@ sub ask_from_listf { $def2 = $v if $def && $_ eq $def; } $def2 ||= $f->($def) if $def; - my $r = ask_from_list($o, $title, $message, \@l, $def2) or return; + my $r = ask_from_list($o, $title, $message, \@l, $def2, $help) or return; $l{$r}; } sub ask_from_list { - my ($o, $title, $message, $l, $def) = @_; + my ($o, $title, $message, $l, $def, $help) = @_; @$l == 0 and die 'ask_from_list: empty list'; @$l == 1 and return $l->[0]; - goto &ask_from_list2; -} - -sub ask_from_list2($$$$;$) { - my ($o, $title, $message, $l, $def) = @_; - - @$l > 10 and $l = [ sort @$l ]; - - $o->ask_from_listW($title, [ deref($message) ], $l, $def || $l->[0]); -} - -sub ask_from_list_with_help_ { - my ($o, $title, $message, $l, $help, $def) = @_; - @$l == 0 and die ''; - @$l == 1 and return $l->[0]; - goto &ask_from_list2_with_help_; -} - -sub ask_from_list_with_help { - my ($o, $title, $message, $l, $help, $def) = @_; - @$l == 0 and die ''; - @$l == 1 and return $l->[0]; - goto &ask_from_list2_with_help; -} - -#- defaults to simple ask_from_list -sub ask_from_list_with_helpW { - my ($o, $title, $messages, $l, $help, $def) = @_; - $o->ask_from_listW($o, $title, $messages, $l, $def); -} - -sub ask_from_list2_with_help_($$$$$;$) { - my ($o, $title, $message, $l, $help, $def) = @_; - untranslate( - ask_from_list_with_help($o, $title, $message, [ map { translate($_) } @$l ], $help, translate($def)), - @$l); + goto &ask_from_list_no_check; } -sub ask_from_list2_with_help($$$$$;$) { - my ($o, $title, $message, $l, $help, $def) = @_; +sub ask_from_list_no_check { + my ($o, $title, $message, $l, $def, $help) = @_; - @$l > 10 and $l = [ sort @$l ]; - - $o->ask_from_list_with_helpW($title, [ deref($message) ], $l, $help, $def || $l->[0]); + if (@$l <= 2) { + ask_from_entries_refH_powered($o, { title => $title, messages => [ deref($message) ], ok => $l->[0], cancel => $l->[1] }, []) + ? $l->[0] : $l->[1]; + } else { + @$l > 10 and $l = [ sort @$l ]; + ask_from_entries_refH($o, $title, $message, [ { val => \$def, type => 'list', list => $l, help => $help } ]); + $def; + } } sub ask_from_treelistf { @@ -175,7 +156,7 @@ sub ask_from_treelist { $o->ask_from_treelistW($title, [ deref($message) ], $separator, [ sort @$l ], $def || $l->[0]); } #- defaults to simple ask_from_list -sub ask_from_treelistW($$$$;$) { +sub ask_from_treelistW { my ($o, $title, $message, $separator, $l, $def) = @_; $o->ask_from_listW($title, [ deref($message) ], $l, $def); } @@ -185,89 +166,77 @@ sub ask_many_from_list { my ($o, $title, $message, @l) = @_; @l = grep { @{$_->{list}} } @l or return ''; foreach my $h (@l) { - $h->{labels} ||= [ map { $h->{label} ? $h->{label}->($_) : $_ } @{$h->{list}} ]; - - if ($h->{sort}) { - my @places = sort { $h->{labels}[$a] cmp $h->{labels}[$b] } 0 .. $#{$h->{labels}}; - $h->{labels} = [ map { $h->{labels}[$_] } @places ]; - $h->{list} = [ map { $h->{list}[$_] } @places ]; - } - $h->{ref} = [ map { - $h->{ref} ? $h->{ref}->($_) : do { - my $i = + $h->{e}{$_} = { + text => $h->{label} ? $h->{label}->($_) : $_, + val => $h->{val} ? $h->{val}->($_) : do { + my $i = $h->{value} ? $h->{value}->($_) : $h->{values} ? member($_, @{$h->{values}}) : 0; \$i; - }; - } @{$h->{list}} ]; - - $h->{help} = $h->{help} ? [ map { $h->{help}->($_) } @{$h->{list}} ] : []; - $h->{icons} = $h->{icon2f} ? [ map { $h->{icon2f}->($_) } @{$h->{list}} ] : []; + }, + type => 'bool', + help => $h->{help} ? $h->{help}->($_) : '', + icon => $h->{icon2f} ? $h->{icon2f}->($_) : '', + } foreach @{$h->{list}}; + if ($h->{sort}) { + $h->{list} = [ sort { $h->{e}{$a}{label} cmp $h->{e}{$b}{label} } @{$h->{list}} ]; + } } - $o->ask_many_from_listW($title, [ deref($message) ], @l) or return; + $o->ask_from_entries_refH($title, $message, [ map { my $h = $_; map { $h->{e}{$_} } @{$h->{list}} } @l ]) or return; @l = map { my $h = $_; - [ grep_index { ${$h->{ref}[$::i]} } @{$h->{list}} ]; + [ grep { ${$h->{e}{$_}{val}} } @{$h->{list}} ]; } @l; wantarray ? @l : $l[0]; } sub ask_from_entry { - my ($o, $title, $message, $label, $def, %callback) = @_; - - first ($o->ask_from_entries($title, [ deref($message) ], [ $label ], [ $def ], %callback)); + my ($o, $title, $message, %callback) = @_; + first(ask_from_entries($o, $title, $message, [''], %callback)); } +sub ask_from_entries { + my ($o, $title, $message, $l, %callback) = @_; -sub ask_from_entries($$$$;$%) { - my ($o, $title, $message, $l, $def, %callback) = @_; - - my $val = [ map { my $i = $_; \$i } @{$def || [('') x @$l]} ]; + my @l = map { my $i = ''; { label => $_, val => \$i } } @$l; - $o->ask_from_entries_ref($title, $message, $l, $val, %callback) ? - map { $$_ } @$val : + $o->ask_from_entries_refH($title, $message, \@l, %callback) ? + map { ${$_->{val}} } @l : undef; } -sub ask_from_entries_refH($$$;$%) { - my ($o, $title, $message, $h, %callback) = @_; - - ask_from_entries_ref($o, $title, $message, - list2kv(@$h), - %callback); -} - #- can get a hash of callback: focus_out changed and complete #- moreove if you pass a hash with a field list -> combo #- if you pass a hash with a field hidden -> emulate stty -echo -sub ask_from_entries_ref($$$$;$%) { - my ($o, $title, $message, $l, $val, %callback) = @_; +sub ask_from_entries_refH { + my ($o, $title, $message, $l, %callback) = @_; return unless @$l; + ask_from_entries_refH_powered($o, { title => $title, messages => [ deref($message) ], callbacks => \%callback }, $l); +} - $title = [ deref($title) ]; - $title->[2] ||= _("Cancel") unless $title->[1]; - $title->[1] ||= _("Ok"); - - my $val_hash = [ map { - if ((ref $_) eq "SCALAR") { - { val => $_ } - } else { - if (@{$_->{list} || []} > 1) { - add2hash_($_, { not_edit => 1, type => 'list' }); - ${$_->{val}} = $_->{list}[0] if $_->{not_edit} && !member(${$_->{val}}, @{$_->{list}}); - } elsif ($_->{type} eq 'range') { - $_->{min} <= $_->{max} or die "bad range min $_->{min} > max $_->{max} (called from " . join(':', caller()) . ")"; - ${$_->{val}} = max($_->{min}, min(${$_->{val}}, $_->{max})); - } - $_; +sub ask_from_entries_refH_powered { + my ($o, $common, $l) = @_; + + #- normalize + foreach (@$l) { + if (@{$_->{list} || []} > 1) { + $_->{type} = 'iconlist' if $_->{icon2f}; + $_->{type} = 'treelist' if $_->{separator}; + add2hash_($_, { not_edit => 1, type => 'combo' }); + ${$_->{val}} = $_->{list}[0] if ($_->{type} ne 'combo' || $_->{not_edit}) && !member(${$_->{val}}, @{$_->{list}}); + } elsif ($_->{type} eq 'range') { + $_->{min} <= $_->{max} or die "bad range min $_->{min} > max $_->{max} (called from " . join(':', caller()) . ")"; + ${$_->{val}} = max($_->{min}, min(${$_->{val}}, $_->{max})); } - } @$val ]; - - $o->ask_from_entries_refW($title, [ deref($message) ], $l, $val_hash, %callback) + } + add2hash_($common->{callbacks} ||= {}, { changed => sub {}, focus_out => sub {}, complete => sub { 0 } }); + $o->ask_from_entries_refW($common, + [ grep { !$_->{advanced} } @$l ], + [ grep { $_->{advanced} } @$l ]) } -sub wait_message($$$;$) { +sub wait_message { my ($o, $title, $message, $temp) = @_; my $w = $o->wait_messageW($title, [ _("Please wait"), deref($message) ]); diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index 8661e2ed3..564e77f25 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -10,7 +10,7 @@ use interactive; use common qw(:common :functional); use my_gtk qw(:helpers :wrappers); -1; +my $forgetTime = 1000; #- in milli-seconds sub new { $::windowheight ||= 400 if $::isStandalone; @@ -28,11 +28,6 @@ sub exit { c::_exit($_[0]) #- workaround } -sub ask_from_listW { - my ($o, $title, $messages, $l, $def) = @_; - ask_from_list_with_helpW($o, $title, $messages, $l, undef, $def); -} - sub test_embedded { my ($w) = @_; $::isEmbedded or return; @@ -44,8 +39,8 @@ sub test_embedded { $::Plug->add($w->{window}); $w->{window}->add($w->{rwindow}); } -sub ask_from_list_with_helpW { - my ($o, $title, $messages, $l, $help, $def) = @_; +sub ask_from_listW { + my ($o, $title, $messages, $l, $def, $help) = @_; my $r; my $w = my_gtk->new(first(deref($title)), %$o); @@ -176,202 +171,188 @@ sub ask_from_treelistW { $w->main or die "ask_from_list cancel"; } -sub ask_many_from_listW { - my ($o, $title, $messages, @l) = @_; - my $w = my_gtk->new('', %$o); - test_embedded($w); - $w->sync; # for XPM's creation +sub create_list { + my ($e, $may_go_to_next_) = @_; + my $list = new Gtk::List(); + $list->set_selection_mode('browse'); + my ($curr); + my $l = $e->{list}; + my $select = sub { + $list->select_item($_[0]); + }; my $tips = new Gtk::Tooltips; - my @boxes; @boxes = map { - my $l = $_; - my $box = gtkpack(new Gtk::VBox(0, @{$l->{icons}} ? 10 : 0), - map_index { - my $i = $::i; - - my $o = Gtk::CheckButton->new($_); - $tips->set_tip($o, $l->{help}[$i]) if $l->{help}[$i]; - $o->set_active(${$l->{ref}[$i]}); - $o->signal_connect(clicked => sub { - my $v = invbool($l->{ref}[$i]); - $boxes[$l->{shadow}]->set_sensitive(!$v) if exists $l->{shadow}; - }); - - my $f = $l->{icons}[$i]; - -e $f ? gtkpack_(new Gtk::HBox(0,10), 0, new Gtk::Pixmap(gtkcreate_xpm($w->{window}, $f)), 1, $o) : $o; - } @{$l->{labels}}); - @{$l->{labels}} > (@{$l->{icons}} ? 5 : 11) ? gtkset_usize(createScrolledWindow($box), @{$l->{icons}} ? 350 : 0, $::windowheight - 200) : $box; - } @l; - gtkadd($w->{window}, - gtkpack_(create_box_with_title($w, @$messages), - (map {; 1, $_, 0, '' } @boxes), - 0, $w->create_okcancel, - ) - ); - $w->{ok}->grab_focus; - $w->main; + my $toselect; + my @widgets = map_index { + my $item = new Gtk::ListItem($_); + $item->signal_connect(key_press_event => sub { + my ($w, $e) = @_; + my $c = chr($e->{keyval} & 0xff); + $may_go_to_next_->($e) if $e->{keyval} < 0x100 ? $c eq ' ' : $c eq "\r" || $c eq "\x8d"; + 1; + }); + $list->append_items($item); + if ($e->{help}) { + $tips->set_tip($item, + ref($e->{help}) eq 'HASH' ? $e->{help}{$_} : + ref($e->{help}) eq 'CODE' ? $e->{help}($_) : $e->{help}); + } + $item->show; + $toselect = $::i if ${$e->{val}} && $_ eq ${$e->{val}}; + $item->grab_focus if ${$e->{val}} && $_ eq ${$e->{val}}; + $item; + } @$l; + + &$select($toselect); + + #- signal_connect after append_items otherwise it is called and destroys the default value + $list->signal_connect(select_child => sub { + my ($w, $row) = @_; + ${$e->{val}} = $l->[$list->child_position($row)]; + }); + + may_createScrolledWindow(@$l > 15, $list, 200, min(350, $::windowheight - 60)), + $list, + sub { $list->select_item(find_index { $_ eq ${$e->{val}} } @$l) }; } sub ask_from_entries_refW { - my ($o, $title, $messages, $l, $val, %hcallback) = @_; - my ($title_, @okcancel) = deref($title); + my ($o, $common, $l, $l2) = @_; my $ignore = 0; #-to handle recursivity - my $w = my_gtk->new($title_, %$o); - test_embedded($w); - $w->sync; # for XPM's creation - - my $set_icon = sub { - my ($i, $button) = @_; - gtkdestroy($i->{icon}); - my $f = $i->{icon2f}->(${$i->{val}}); - $i->{icon} = -e $f ? - new Gtk::Pixmap(gtkcreate_xpm($w->{window}, $f)) : - new Gtk::Label(translate(${$i->{val}})); - $button->add($i->{icon}); - $i->{icon}->show; - }; + my $mainw = my_gtk->new($common->{title}, %$o); + test_embedded($mainw); + $mainw->sync; # for XPM's creation #-the widgets - my @widgets = map { - my $i = $_; - - $i->{type} = "iconlist" if $i->{type} eq "list" && $i->{not_edit} && $i->{icon2f}; - - if ($i->{type} eq "list") { - my $w = new Gtk::Combo; - $w->set_use_arrows_always(1); - $w->entry->set_editable(!$i->{not_edit}); - $w->set_popdown_strings(@{$i->{list}}); - $w->disable_activate; - $w; - } elsif ($i->{type} eq "iconlist") { - my $w = new Gtk::Button; - $w->signal_connect(clicked => sub { - ${$i->{val}} = next_val_in_array(${$i->{val}}, $i->{list}); - $set_icon->($i, $w); - }); - $set_icon->($i, $w); - gtkpack_(new Gtk::HBox(0,10), 1, new Gtk::HBox(0,0), 0, $w, 1, new Gtk::HBox(0,0), ); - } elsif ($i->{type} eq "bool") { - my $w = Gtk::CheckButton->new($i->{text}); - $w->set_active(${$i->{val}}); - $w->signal_connect(clicked => sub { $ignore or invbool \${$i->{val}} }); - $w; - } elsif ($i->{type} eq "range") { - my $adj = create_adjustment(${$i->{val}}, $i->{min}, $i->{max}); - $adj->signal_connect(value_changed => sub { ${$i->{val}} = $adj->get_value }); - my $w = new Gtk::HScale($adj); - $w->set_digits(0); - $w; - } else { - new Gtk::Entry; - } - } @$val; - my $ok = $w->create_okcancel(@okcancel); + my (@widgets, @widgets_always, @widgets_advanced, $advanced, $advanced_pack); + my $tooltips = new Gtk::Tooltips; + + my $set_all = sub { + $ignore = 1; + $_->{set}->(${$_->{e}{val}}) foreach @widgets_always, @widgets_advanced; + $ignore = 0; + }; + my $get_all = sub { + ${$_->{e}{val}} = $_->{get}->() foreach @widgets_always, @widgets_advanced; + }; + my $create_widget = sub { + my ($e, $ind) = @_; - sub widget { - my ($w, $ref) = @_; - ($ref->{type} eq "list" && @{$ref->{list}}) ? $w->entry : $w - } - my @updates = mapn { - my ($w, $ref) = @_; - sub { - $ref->{type} =~ /bool|range|iconlist/ and return; - ${$ref->{val}} = widget($w, $ref)->get_text; - }; - } \@widgets, $val; - - my @updates_inv = mapn { - my ($w, $ref) = @_; - sub { - $ref->{type} =~ /iconlist/ and return; - $ref->{type} eq "bool" ? - $w->set_active(${$ref->{val}}) : - widget($w, $ref)->set_text(${$ref->{val}}) - }; - } \@widgets, $val; - - - for (my $i = 0; $i < @$l; $i++) { - my $ind = $i; #-cos lexical bindings pb !! - my $widget = widget($widgets[$i], $val->[$i]); - my $changed_callback = sub { - return if $ignore; #-handle recursive deadlock - &{$updates[$ind]}; - if ($hcallback{changed}) { - &{$hcallback{changed}}($ind); - #update all the value - $ignore = 1; - &$_ foreach @updates_inv; - $ignore = 0; - }; - }; my $may_go_to_next = sub { - my ($W, $e) = @_; - if (($e->{keyval} & 0x7f) == 0xd) { - $W->signal_emit_stop("key_press_event"); - if ($ind == $#$l) { - @$l == 1 ? $w->{ok}->clicked : $w->{ok}->grab_focus; + my ($w, $e) = @_; + if (!$e || ($e->{keyval} & 0x7f) == 0xd) { + $w->signal_emit_stop("key_press_event") if $e; + if ($ind == $#widgets) { + @widgets == 1 ? $mainw->{ok}->clicked : $mainw->{ok}->grab_focus; } else { - widget($widgets[$ind+1],$val->[$ind+1])->grab_focus; + $widgets[$ind+1]{w}->grab_focus; } } }; + my $changed = sub { + return if $ignore; + $get_all->(); + $common->{callbacks}{changed}->($ind); + $set_all->(); + }; - if ($hcallback{focus_out}) { - my $focusout_callback = sub { - return if $ignore; - &{$hcallback{focus_out}}($ind); - #update all the value - $ignore = 1; - &$_ foreach @updates_inv; - $ignore = 0; + my ($w, $real_w, $set, $get); + if ($e->{type} eq "iconlist") { + $w = new Gtk::Button; + $set = sub { + gtkdestroy($e->{icon}); + my $f = $e->{icon2f}->($_[0]); + $e->{icon} = -e $f ? + new Gtk::Pixmap(gtkcreate_xpm($mainw->{window}, $f)) : + new Gtk::Label(translate($_[0])); + $w->add($e->{icon}); + $e->{icon}->show; }; - $widget->signal_connect(focus_out_event => $focusout_callback); - } - if (ref $widget eq "Gtk::HScale") { - $widget->signal_connect(key_press_event => $may_go_to_next); - } - if (ref $widget eq "Gtk::Entry") { - $widget->signal_connect(changed => $changed_callback); - $widget->signal_connect(key_press_event => $may_go_to_next); - $widget->set_text(${$val->[$i]{val}}); - $widget->set_visibility(0) if $val->[$i]{hidden}; - } - &{$updates[$i]}; - } - - my @entry_list = mapn { [($_[0], $_[1])]} $l, \@widgets; - - gtkadd($w->{window}, - gtkpack( - create_box_with_title($w, @$messages), - create_packtable({}, @entry_list), - $ok - )); - widget($widgets[0],$val->[0])->grab_focus(); - -# mapn { $_[0]{expert} and $_[1]->hide } $val, \@widgets, $l; - - if ($hcallback{complete}) { - my $callback = sub { - my ($error, $focus) = &{$hcallback{complete}}; - #-update all the value - $ignore = 1; - foreach (@updates_inv) { &{$_};} - $ignore = 0; - if ($error) { - $focus ||= 0; - widget($widgets[$focus], $val->[$focus])->grab_focus(); + $w->signal_connect(clicked => sub { + $set->(${$e->{val}} = next_val_in_array(${$e->{val}}, $e->{list})); + $changed->(); + }); + $real_w = gtkpack_(new Gtk::HBox(0,10), 1, new Gtk::HBox(0,0), 0, $w, 1, new Gtk::HBox(0,0), ); + } elsif ($e->{type} eq "bool") { + $w = Gtk::CheckButton->new($e->{text}); + $w->signal_connect(clicked => $changed); + $set = sub { $w->set_active($_[0]) }; + $get = sub { $w->get_active }; + } elsif ($e->{type} eq "range") { + my $adj = create_adjustment(${$e->{val}}, $e->{min}, $e->{max}); + $adj->signal_connect(value_changed => $changed); + $w = new Gtk::HScale($adj); + $w->set_digits(0); + $w->signal_connect(key_press_event => $may_go_to_next); + $set = sub { $adj->set_value($_[0]) }; + $get = sub { $adj->get_value }; + } elsif ($e->{type} eq "list") { + #- use only when needed, as key bindings are dropped by List (CList does not seems to accepts Tooltips). +# if ($e->{help}) { + ($real_w, $w, $set) = create_list($e, $may_go_to_next); +# } else { +# die; +# } + } else { + if ($e->{type} eq "combo") { + $w = new Gtk::Combo; + $w->set_use_arrows_always(1); + $w->entry->set_editable(!$e->{not_edit}); + $w->set_popdown_strings(@{$e->{list}}); + $w->disable_activate; + ($real_w, $w) = ($w, $w->entry); } else { - return 1; + $w = new Gtk::Entry(${$e->{val}}); } - }; - $w->main($callback); - } else { - $w->main(); - } + $w->signal_connect(key_press_event => $may_go_to_next); + $w->signal_connect(changed => $changed); + $w->set_visibility(0) if $e->{hidden}; + $set = sub { $w->set_text($_[0]) }; + $get = sub { $w->get_text }; + } + $w->signal_connect(focus_out_event => sub { + return if $ignore; + $get_all->(); + $common->{callbacks}{focus_out}->($ind); + $set_all->(); + }); + $tooltips->set_tip($w, $e->{help}) if $e->{help} && !ref($e->{help}); + + { e => $e, w => $w, real_w => $real_w || $w, + get => $get || sub { ${$e->{val}} }, set => $set || sub {}, + icon_w => -e $e->{icon} ? new Gtk::Pixmap(gtkcreate_xpm($mainw->{window}, $e->{icon})) : '' }; + }; + @widgets_always = map_index { $create_widget->($_, $::i ) } @$l; + @widgets_advanced = map_index { $create_widget->($_, $::i + @$l) } @$l2; + + my $set_advanced = sub { + ($advanced) = @_; + $advanced ? $advanced_pack->show : $advanced_pack->hide; + @widgets = (@widgets_always, $advanced ? @widgets_advanced : ()); + }; + my $advanced_button = [ _("Advanced"), sub { $set_advanced->(!$advanced) } ]; + + $set_all->(); + gtkadd($mainw->{window}, + gtkpack(create_box_with_title($mainw, @{$common->{messages}}), + may_createScrolledWindow(@widgets_always > 8, create_packtable({}, map { [($_->{icon_w}, $_->{e}{label}, $_->{real_w})]} @widgets_always), 200, min(350, $::windowheight - 60)), + new Gtk::HSeparator, + $advanced_pack = create_packtable({}, map { [($_->{icon_w}, $_->{e}{label}, $_->{real_w})]} @widgets_advanced), + $mainw->create_okcancel($common->{ok}, $common->{cancel}, '', @$l2 ? $advanced_button : ()))); + $set_advanced->(0); + (@widgets ? $widgets[0]{w} : $mainw->{ok})->grab_focus(); + + $mainw->main(sub { + $get_all->(); + my ($error, $focus) = $common->{callbacks}{complete}->(); + + if ($error) { + $set_all->(); + $widgets[$focus || 0]{w}->grab_focus(); + } + !$error; + }); } @@ -414,3 +395,5 @@ sub kill { } $o->{before_killing} = @interactive::objects; } + +1; diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index be66c9ca6..791a741f0 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -9,7 +9,7 @@ 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) ], + helpers => [ qw(create_okcancel createScrolledWindow may_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__ gtkpack2 gtkpack3 gtkpack2_ gtkpack2__ gtksetstyle gtkappend gtkadd gtkput 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) ], ); @@ -237,7 +237,7 @@ sub gtkxpm { new Gtk::Pixmap(gtkcreate_xpm(@_)) } #-############################################################################### sub create_okcancel { - my ($w, $ok, $cancel, $spread) = @_; + my ($w, $ok, $cancel, $spread, @other) = @_; my $one = ($ok xor $cancel); $spread ||= $::isWizard ? "edge" : "spread"; $ok ||= $::isWizard ? _("Next ->") : _("Ok"); @@ -245,6 +245,7 @@ sub create_okcancel { my $b1 = gtksignal_connect($w->{ok} = new Gtk::Button($ok), clicked => $w->{ok_clicked} || sub { $::isWizard or $w->{retval} = 1; Gtk->main_quit }); my $b2 = !$one && gtksignal_connect($w->{cancel} = new Gtk::Button($cancel || _("Cancel")), clicked => $w->{cancel_clicked} || sub { log::l("default cancel_clicked"); undef $w->{retval}; Gtk->main_quit }); my @l = grep { $_ } $::isWizard ? ($b2, $b1) : ($b1, $b2); + push @l, map { gtksignal_connect(new Gtk::Button($_->[0]), clicked => $_->[1]) } @other; $_->can_default($::isWizard) foreach @l; gtkadd(create_hbox($spread), @l); @@ -267,7 +268,7 @@ sub create_box_with_title($@) { ); } -sub createScrolledWindow($) { +sub createScrolledWindow { my ($W) = @_; my $w = new Gtk::ScrolledWindow(undef, undef); $w->set_policy('automatic', 'automatic'); @@ -279,6 +280,11 @@ sub createScrolledWindow($) { $w } +sub may_createScrolledWindow { + my ($bool, $list, $width, $height) = @_; + $bool ? gtkset_usize(createScrolledWindow($list), $width, $height) : $list; +} + sub create_menu($@) { my $title = shift; my $w = new Gtk::MenuItem($title); @@ -317,7 +323,7 @@ sub create_packtable($@) { my ($j) = @_; if (defined $_) { ref $_ or $_ = new Gtk::Label($_); - $w->attach_defaults($_, $j, $j + 1, $i, $i + 1); + $w->attach($_, $j, $j + 1, $i, $i + 1, 'fill', 'fill', 5, 0); $_->show; } } @$_; @@ -566,7 +572,7 @@ sub _ask_from_list { gtkadd($o->{window}, gtkpack($o->create_box_with_title(@$messages), gtkpack_(new Gtk::VBox(0,7), - 1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, min(350, $::windowheight - 60)) : $list, + 1, may_createScrolledWindow(@$l > 15, $list, 200, min(350, $::windowheight - 60)), @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ()) )); $o->show; #- otherwise the moveto is not done @@ -578,81 +584,6 @@ sub _ask_from_list { $list->grab_focus; } -sub _ask_from_list_with_help { - my ($o, $title, $messages, $l, $help, $def) = @_; - my (undef, @okcancel) = ref $title ? @$title : $title; - my $list = new Gtk::List(); - my ($first_time, $starting_word, $start_reg) = (1, '', "^"); - my (@widgets, $timeout, $curr); - - my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit }; - my $select = sub { - $list->select_item($_[0]); - }; - - ref $title && !@okcancel ? - $list->signal_connect(button_release_event => $leave) : - $list->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ }); - - $list->signal_connect(select_child => sub { - my ($w, $row) = @_; - $curr = $list->child_position($row); - }); - $list->signal_connect(key_press_event => sub { - my ($w, $e) = @_; - my $c = chr($e->{keyval} & 0xff); - - Gtk->timeout_remove($timeout) if $timeout; $timeout = ''; - - if ($e->{keyval} >= 0x100) { - &$leave if $c eq "\r" || $c eq "\x8d"; - $starting_word = '' if $e->{keyval} != 0xffe4; # control - } else { - if ($e->{state} & 4) { - #- control pressed - $c eq "s" or return 1; - $start_reg and $start_reg = '', return 1; - $curr++; - } else { - &$leave if $c eq ' '; - - $curr++ if $starting_word eq '' || $starting_word eq $c; - $starting_word .= $c unless $starting_word eq $c; - } - my $word = quotemeta $starting_word; - my $j; for ($j = 0; $j < @$l; $j++) { - $l->[($j + $curr) % @$l] =~ /$start_reg$word/i and last; - } - $j == @$l ? - $starting_word = '' : - &$select(($j + $curr) % @$l); - - $w->{timeout} = $timeout = Gtk->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 } ); - } - 1; - }); - - $o->{ok_clicked} = $leave; - $o->{cancel_clicked} = sub { $o->destroy; die "ask_from_list cancel" }; #- make sure windows doesn't live any more. - gtkadd($o->{window}, - gtkpack($o->create_box_with_title(@$messages), - gtkpack_(new Gtk::VBox(0,7), - 1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, min(350, $::windowheight - 60)) : $list, - @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ()) - )); - $o->show; #- otherwise the moveto is not done - my $tips = new Gtk::Tooltips; - my $toselect; map_index { - my $item = new Gtk::ListItem($_); - $list->append_items($item); - $tips->set_tip($item, $help->{$_}) if $help->{$_}; - $item->show; - $toselect = $::i if $def && $_ eq $def; - } @$l; - &$select($toselect); - - $list->grab_focus; -} sub _ask_warn($@) { my ($o, @msgs) = @_; diff --git a/perl-install/network.pm b/perl-install/network.pm index 5e687c857..f5fe364fb 100644 --- a/perl-install/network.pm +++ b/perl-install/network.pm @@ -272,12 +272,12 @@ sub configureNetwork { $netc->{minus_one} = 1; my $dhcp_hostname = $netc->{HOSTNAME}; $::isInstall and $in->set_help('configureNetworkHostDHCP'); - $in->ask_from_entries_ref(_("Configuring network"), + $in->ask_from_entries_refH(_("Configuring network"), _("Please enter your host name if you know it. Some DHCP servers require the hostname to work. Your host name should be a fully-qualified host name, such as ``mybox.mylab.myco.com''."), - [_("Host name")], [ \$netc->{HOSTNAME} ]); + [ { label => _("Host name"), val => \$netc->{HOSTNAME} }]); $netc->{HOSTNAME} ne $dhcp_hostname and $netc->{DHCP_HOSTNAME} = $netc->{HOSTNAME}; } else { configureNetworkNet($in, $netc, $last ||= {}, @l); @@ -310,11 +310,12 @@ notation (for example, 1.2.3.4)."); delete $intf->{BROADCAST}; my @fields = qw(IPADDR NETMASK); $::isStandalone or $in->set_help('configureNetworkIP'); - $in->ask_from_entries_ref(_("Configuring network device %s", $intf->{DEVICE}), + $in->ask_from_entries_refH(_("Configuring network device %s", $intf->{DEVICE}), ($::isStandalone ? '' : _("Configuring network device %s", $intf->{DEVICE}) . "\n\n") . $text, - [ _("IP address"), _("Netmask"), _("Automatic IP") ], - [ \$intf->{IPADDR}, \$intf->{NETMASK}, { val => \$pump, type => "bool", text => _("(bootp/dhcp)") } ], + [ { label => _("IP address"), val => \$intf->{IPADDR} }, + { label => _("Netmask"), val => \$intf->{NETMASK} }, + { label => _("Automatic IP"), val => \$pump, type => "bool", text => _("(bootp/dhcp)") } ], complete => sub { $intf->{BOOTPROTO} = $pump ? "dhcp" : "static"; return 0 if $pump; @@ -356,13 +357,10 @@ sub miscellaneousNetwork { my ($in, $clicked) = @_; my $u = $::o->{miscellaneous} ||= {}; $::isInstall and $in->set_help('configureNetworkProxy'); - !$::beginner || $clicked and $in->ask_from_entries_ref('', + !$::beginner || $clicked and $in->ask_from_entries_refH('', _("Proxies configuration"), - [ _("HTTP proxy"), - _("FTP proxy"), - ], - [ \$u->{http_proxy}, - \$u->{ftp_proxy}, + [ { label => _("HTTP proxy"), val => \$u->{http_proxy} }, + { label => _("FTP proxy"), val => \$u->{ftp_proxy} }, ], complete => sub { $u->{http_proxy} =~ m,^($|http://), or $in->ask_warn('', _("Proxy should be http://...")), return 1,0; diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm index 4081b9721..0744f0738 100644 --- a/perl-install/printerdrake.pm +++ b/perl-install/printerdrake.pm @@ -236,12 +236,11 @@ sub setup_gsdriver_lpr($$$;$) { do { $printer->{DBENTRY} ||= $printer::thedb_gsdriver{$printer->{GSDRIVER}}{ENTRY}; eval { $printer->{DBENTRY} = $printer::descr_to_db{ - $in->ask_from_list_with_help_(_("Configure Printer"), - _("What type of printer do you have?"), - [ @printer::entry_db_description ], - { %printer::descr_to_help }, - $printer::db_to_descr{$printer->{DBENTRY}}, - ) + $in->ask_from_list_(_("Configure Printer"), + _("What type of printer do you have?"), + [ @printer::entry_db_description ], + $printer::db_to_descr{$printer->{DBENTRY}}, + { %printer::descr_to_help }) }; }; $@ =~ /^ask_from_list cancel/ and return; |