diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 12:26:16 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 12:26:16 +0000 |
commit | 126777bc019a54afb4ec51299f2cf9d2841698aa (patch) | |
tree | 97f76e571902ead55ba138f1156a4b4f00b9b779 /perl-install/interactive | |
parent | f1f67448efc714873378dfeb8279fae68054a90a (diff) | |
download | drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.gz drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.bz2 drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.xz drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.zip |
re-sync after the big svn loss
Diffstat (limited to 'perl-install/interactive')
-rw-r--r-- | perl-install/interactive/curses.pm | 591 | ||||
-rw-r--r-- | perl-install/interactive/gtk.pm | 830 | ||||
-rw-r--r-- | perl-install/interactive/http.pm | 8 | ||||
-rw-r--r-- | perl-install/interactive/newt.pm | 423 | ||||
-rw-r--r-- | perl-install/interactive/stdio.pm | 19 |
5 files changed, 1055 insertions, 816 deletions
diff --git a/perl-install/interactive/curses.pm b/perl-install/interactive/curses.pm new file mode 100644 index 000000000..b8da3c29a --- /dev/null +++ b/perl-install/interactive/curses.pm @@ -0,0 +1,591 @@ +# implementer tree + +# to debug, use something like +# PERLDB_OPTS=TTY=`tty` LC_ALL=fr_FR.UTF-8 xterm -geometry 80x25 -e sh -c 'DISPLAY= perl -d t.pl' + +package interactive::curses; # $Id$ + +use diagnostics; +use strict; +use vars qw(@ISA); + +@ISA = qw(interactive); + +use interactive; +use common; +use log; +use Curses::UI; + +my $SAVEERR; +my $stderr_file = "/tmp/curses-stderr.$$"; +my $padleft = 1; +my $padright = 1; +my $indent = 1; +my $cui; + +sub new { + my ($class) = @_; + if ($::isInstall && !$::local_install) { + system('unicode_start'); #- do not use run_program, we must do it on current console + } + open $SAVEERR, ">&STDERR"; + open STDERR, ">", common::secured_file($stderr_file); + + $cui ||= Curses::UI->new('-color_support' => 1); + bless { cui => $cui }, $class; +} + +sub enter_console { &suspend } +sub leave_console { &end } +sub suspend { Curses::UI->leave_curses } +sub resume { Curses::UI->reset_curses } +sub end { &suspend; print $SAVEERR $_ foreach cat_($stderr_file); unlink $stderr_file } +sub exit { end(); CORE::exit($_[1] || 0) } +END { end() } + +sub _messages { + my ($width, @messages) = @_; + warp_text(join("\n", @messages), $width); +} + +sub _enable_disable { + my ($w, $disabled) = @_; + + if ($disabled ? $w->{'-is-disabled'} : !$w->{'-is-disabled'}) { + return; + } + $w->{'-is-disabled'} = $disabled; + + if ($disabled) { + add2hash_($w, { '-was-focusable' => $w->focusable, '-was-fg' => $w->{'-fg'}, '-was-bfg' => $w->{'-bfg'} }); + $w->focusable(0); + $w->{'-fg'} = $w->{'-bfg'} = 'blue'; + } else { + $w->focusable($w->{'-was-focusable'}); + $w->{'-fg'} = $w->{'-was-fg'}; + $w->{'-bfg'} = $w->{'-was-bfg'}; + } + $w->intellidraw; +} + +sub filter_widget { + my ($e) = @_; + + if ($e->{title} || $e->{type} eq 'expander') { + $e->{no_indent} = 1; + } + + $e->{type} = 'list' if $e->{type} =~ /iconlist|treelist/; + + #- combo does not allow modifications + $e->{type} = 'entry' if $e->{type} eq 'combo' && !$e->{not_edit}; + + $e->{formatted_list} = [ map { may_apply($e->{format}, $_) } @{$e->{list}} ]; + + $e->{default_curses} ||= delete $e->{curses}; +} +sub filter_widgets { + my ($l) = @_; + + filter_widget($_) foreach @$l; + + map { + if (@$_ > 1) { + my $e = { type => 'checkboxes', label => $_->[0]{label}, val => \ (my $_ignored), + list => [ map { $_->{text} } @$_ ], children => $_ }; + filter_widget($e); + $e; + } else { + @$_; + } + } common::group_by { !$_[0]{disabled} && + $_[0]{type} eq 'bool' && $_[1]{type} eq 'bool' + && !$_[1]{label} } @$l; +} + + +sub heights { + my ($best, @fallbacks) = @_; + join(',', $best, grep { $_ < $best } @fallbacks); +} + +sub entry_height { + my ($e) = @_; + to_int(max($e->{curses}{'-height'}, $e->{label_height} || 0)); +} + +sub compute_label_size { + my ($e, $available_width, $o_fixed_width) = @_; + + $e->{label} or return; + + my @text = _messages(min(80, $o_fixed_width || $available_width), $e->{label}); + $e->{label_text_wrapped} = join("\n", @text); + $e->{label_height} = int(@text); + $e->{label_width} = $o_fixed_width || max(map { length } @text); +} +sub compute_label_sizes { + my ($cui, $wanted_widgets) = @_; + + my $available_width = $cui->{'-width'} - 4; + + foreach (@$wanted_widgets) { + compute_label_size($_, $available_width); + } +} + +sub compute_size { + my ($e, $previous_e, $available_width, $o_labels_width) = @_; + + { + my %c = %{$e->{default_curses} || {}}; + $e->{curses} = \%c; + } + #- if $o_labels_width is given, it will be used + compute_label_size($e, $available_width, $o_labels_width); + $e->{curses}{'-x'} ||= + $previous_e && $previous_e->{same_line} ? 1 + $previous_e->{curses}{'-x'} + $previous_e->{curses}{'-width'} : + $e->{no_indent} ? $padleft : + $padleft + $indent + ($e->{label_width} ? $e->{label_width} + 1 : 0); + + my $width_avail = $available_width - $e->{curses}{'-x'}; + + if ($e->{type} eq 'bool') { + my $indent = length("[X] "); + my @text = _messages($width_avail - $indent, $e->{text} || ''); + $e->{curses}{'-height'} ||= heights(int(@text), 4); + $e->{curses}{'-width'} ||= max(map { length } @text) + $indent + 1; + $e->{curses}{'-label'} = join("\n", @text); + } elsif ($e->{type} eq 'combo') { + $e->{curses}{'-height'} ||= 1; + $e->{curses}{'-width'} ||= max(map { length } @{$e->{formatted_list}}) + 3; + } elsif ($e->{type} eq 'checkboxes') { + $e->{curses}{'-height'} ||= heights(map { $_ + 2 } int(@{$e->{formatted_list}}), 10, 4); + $e->{curses}{'-width'} ||= max(map { length } @{$e->{formatted_list}}) + 7; + } elsif ($e->{type} =~ /list/) { + $e->{curses}{'-height'} ||= heights(map { $_ + 2 } int(@{$e->{formatted_list}}), 5, 4); + $e->{curses}{'-width'} ||= max(map { length } @{$e->{formatted_list}}) + 3; + } elsif ($e->{type} eq 'button') { + my $s = sprintf('< %s >', may_apply($e->{format}, ${$e->{val}})); + $e->{curses}{'-width'} ||= length($s); + } elsif ($e->{type} eq 'expander') { + $e->{curses}{'-width'} ||= length("<+> $e->{text}"); + } elsif ($e->{type} eq 'text' || $e->{type} eq 'label' || $e->{type} eq 'only_label') { + my @text = _messages(min(80, $width_avail - 1), ${$e->{val}}); #- -1 because of the scrollbar + $e->{curses}{'-focusable'} = 0; + $e->{curses}{'-height'} ||= heights(int(@text), 10, 4); + $e->{curses}{'-width'} ||= 1 + max(map { length } @text); + } else { + $e->{curses}{'-width'} ||= 20; + } + $e->{curses}{'-height'} ||= 1; + +} + +sub compute_sizes { + my ($cui, $wanted_widgets, $o_labels_width, $b_first_time) = @_; + + my ($available_width, $available_height) = ($cui->{'-width'} - 2, $cui->{'-height'} - 2); + + my $previous; + foreach (@$wanted_widgets) { + compute_size($_, $previous, $available_width, $o_labels_width); + $previous = $_; + } + + my $width = max(map { $_->{curses}{'-x'} + $_->{curses}{'-width'} } @$wanted_widgets); + if ($width > $available_width) { + log::l("oops, could not fit... (width $width > $available_width)\n"); + if ($o_labels_width && $b_first_time) { + log::l("retrying without aligning entries"); + return compute_sizes($cui, $wanted_widgets); + } elsif (!$o_labels_width) { + my $width_no_labels = 4 + max(map { $_->{label} ? $_->{curses}{'-width'} : 0 } @$wanted_widgets); + if ($width_no_labels < $available_width) { + #- trying to force a smaller labels width + log::l("retrying forcing a smaller size for labels ($available_width - $width_no_labels)"); + return compute_sizes($cui, $wanted_widgets, $available_width - $width_no_labels); + } else { + log::l("going on even if labels are too wide ($width_no_labels >= $available_width"); + } + } else { + log::l("going on even if labels can't fit forced to $o_labels_width ($width < $available_width)"); + } + } + my $height; + my $i = @$wanted_widgets; + retry: while (1) { + $height = sum(map { entry_height($_) } grep { !$_->{same_line} } @$wanted_widgets) + 1; + $height > $available_height or last; + while ($i--) { + if ($wanted_widgets->[$i]{curses}{'-height'} =~ s/\d+,//) { +#- warn "retring after modifying $wanted_widgets->[$i]{type}\n"; + if ($wanted_widgets->[$i]{type} eq 'text') { + $wanted_widgets->[$i]{curses}{'-vscrollbar'} = 1; + $wanted_widgets->[$i]{curses}{'-focusable'} = 1; + } + goto retry; + } + } + log::l("oops, could not fit... (height $height > $available_height)\n"); + if ($o_labels_width) { + log::l("retrying without aligning entries"); + compute_sizes($cui, $wanted_widgets); + } else { + #- hum, we need to use expander to split things + my $nb; + my $height = 5; #- room from buttons and expander + foreach (@$wanted_widgets) { + $height += to_int($_->{curses}{'-height'}) if !$_->{same_line}; + $height <= $available_height or die "too_many $nb\n"; + $nb++; + } + internal_error("should have died"); + } + } + + +{ + '-x' => int(($available_width - $width) / 2 - 1), + '-y' => int(($available_height - $height) / 2 - 1), + '-width' => $width + 2, + '-height' => $height + 2, + }; +} + +sub compute_buttons { + my ($common, $validate) = @_; + + my %buttons = (ok => $common->{ok}, cancel => $common->{cancel}); + if (!defined $buttons{cancel} && !defined $buttons{ok}) { + $buttons{cancel} = $::isWizard && !$::Wizard_no_previous ? N("Previous") : N("Cancel"); +# $need_to_die = 1 if !($::isWizard && !$::Wizard_no_previous); + } + $buttons{ok} ||= $::isWizard ? ($::Wizard_finished ? N("Finish") : N("Next")) : N("Ok"); + + my @button_names = grep { $buttons{$_} } 'ok', 'cancel'; + @button_names = reverse(@button_names) if $::isWizard; + + my $same_line = @button_names; + + my %buttons_e = map { + my $name = $_; + my $label = "< $buttons{$name} >"; + + $name => + { type => 'button', val => \$buttons{$name}, same_line => --$same_line, no_indent => 1, + default_curses => { '-height' => 1, '-width' => length($label) }, + clicked_may_quit => $name eq 'ok' ? $validate : sub { '0 but true' }, + }; + } @button_names; + + $buttons_e{$common->{focus_cancel} ? 'cancel' : 'ok'}{focus} = sub { 1 }; + $buttons_e{ok}{disabled} = $common->{ok_disabled} if $common->{ok_disabled}; + + map { $buttons_e{$_} } @button_names; +} + +sub create_widget { + my ($cui, $win, $e, $y, $changed, $focus_out) = @_; + + my $onchange = sub { + my ($f) = @_; + sub { + ${$e->{val}} = $f->(); + $changed->() if $changed; + }; + }; + + #- take the best remaining proposed height + $e->{curses}{'-height'} = to_int($e->{curses}{'-height'}); + + my %options = ('-y' => $y, %{$e->{curses}}); + + if ($e->{label}) { + $e->{label_w} = $win->add(undef, + $e->{label_height} <= 1 ? 'Label' : + ('TextViewer', + '-width' => $e->{label_width}, + '-focusable' => 0, + '-height' => $e->{label_height}), + '-text' => $e->{label_text_wrapped}, + '-y' => $options{'-y'}, '-x' => $padleft + 1, + ); + } + + if (!$e->{same_line}) { + delete $options{'-width'}; + $options{'-padright'} = $padright; + } + $options{'-onblur'} = $focus_out if $focus_out; + + my ($w, $set); + if ($e->{type} eq 'bool') { + $w = $win->add( + undef, 'Checkbox', + '-checked' => ${$e->{val}}, + '-onchange' => $onchange->(sub { $w->get }), + %options); + $set = sub { my $meth = $_[0] ? 'check' : 'uncheck'; $w->$meth; $w->intellidraw }; + } elsif ($e->{type} eq 'expander') { + my $toggle_s = '<+> '; + $e->{label_w} = $win->add(undef, 'Label', '-bold' => 1, '-text' => $toggle_s, %options); + $options{'-x'} += length($toggle_s); + $w = $win->add(undef, 'Buttonbox', '-buttons' => [ { + '-label' => $e->{text}, + '-onpress' => sub { + my $common = { ok => "Close", cancel => '', messages => [ if_($e->{message}, $e->{message}) ] }; + ask_fromW_($cui, $common, $e->{children}); + }, + } ], %options); + } elsif ($e->{type} eq 'button') { + my $clicked_may_quit = delete $options{clicked_may_quit}; + $w = $win->add(undef, 'Buttonbox', '-buttons' => [ { + '-onpress' => $clicked_may_quit || sub { 1 }, + } ], %options); + $w->set_binding('focus-up', Curses::KEY_LEFT()); + $w->set_binding('focus-down', Curses::KEY_RIGHT()); + $set = sub { $w->set_label(0, sprintf('< %s >', may_apply($e->{format}, $_[0]))) }; + } elsif ($e->{type} eq 'list' || $e->{type} eq 'combo') { + $w = $win->add(undef, $e->{type} eq 'combo' ? 'Popupmenu' : 'Listbox', + '-values' => $e->{formatted_list}, + '-onchange' => $onchange->(sub { $e->{list}[$w->id] }), + if_($e->{type} eq 'list', + '-vscrollbar' => 1, + '-onselchange' => sub { + #- we don't want selection AND active, so ensuring they are the same + $w->id == $w->get_active_id or $w->set_selection($w->get_active_id); + }), + %options); + $set = sub { + my ($val) = @_; + my $s = may_apply($e->{format}, $val); + eval { + my $id = find_index { $s eq $_ } @{$e->{formatted_list}}; + $w->set_selection($id); + if ($w->can('set_active_id')) { + $w->set_active_id($id); + $w->intellidraw; + } + }; + }; + } elsif ($e->{type} eq 'checkboxes') { + my @selection; + $w = $win->add(undef, 'Listbox', + '-values' => $e->{formatted_list}, + '-vscrollbar' => 1, + '-multi' => 1, + '-onselchange' => sub { + my @new = $w->id; + my %ids = ( + (map { $_ => 1 } difference2(\@new, \@selection)), + (map { $_ => 0 } difference2(\@selection, \@new)), + ); + foreach (keys %ids) { + my $sub_e = $e->{children}[$_]; + ${$sub_e->{val}} = $ids{$_}; + $changed->() if $changed; + } + }, + %options); + $set = sub { + @selection = map_index { if_(${$_->{val}}, $::i) } @{$e->{children}}; + $w->set_selection(@selection); + }; + } elsif ($e->{type} eq 'only_label' && $e->{curses}{'-height'} == 1) { + $w = $win->add(undef, 'Label', '-text' => ${$e->{val}}, + if_($e->{title}, '-bold' => 1), + %options); + } elsif ($e->{type} eq 'label' && $e->{curses}{'-height'} == 1) { + $w = $win->add(undef, 'Label', %options); + $set = sub { $w->text($_[0] || '') }; + } elsif ($e->{type} eq 'label' || $e->{type} eq 'only_label' || $e->{type} eq 'text') { + $w = $win->add(undef, 'TextViewer', %options); + $set = sub { + my ($text) = @_; + my $width = $w->{'-sw'} - ($w->{'-vscrollbar'} ? 1 : 0); + $w->text(join("\n", _messages($width, $text))); + }; + } else { + $w = $win->add(undef, $e->{hidden} ? 'PasswordEntry' : 'TextEntry', + '-sbborder' => 1, + '-text' => '', + '-onchange' => $onchange->(sub { $w->text }), + %options); + $set = sub { $w->text($_[0] || '') }; + } + + $e->{w} = $w; + $e->{set} = $set || sub {}; +} + +sub create_widgets { + my ($cui, $win, $l) = @_; + + my $ignore; #-to handle recursivity + my $set_all = sub { + $ignore = 1; + foreach my $e (@$l) { + $e->{set}->(${$e->{val}}); + my $disabled = $e->{disabled} && $e->{disabled}(); + _enable_disable($e->{w}, $disabled); + _enable_disable($e->{label_w}, $disabled) if $e->{label_w}; + } + $ignore = 0; + }; + my $sub_update = sub { + my ($f) = @_; + sub { + return if $ignore; + $f->() if $f; + $set_all->(); + }; + }; + + my $to_focus; + my $y = 1; + foreach (@$l) { + my $e = $_; + + $e->{curses}{clicked_may_quit} = sub { + if (my $v = $e->{clicked_may_quit}()) { + die "exit_mainloop $v"; + } + $set_all->(); + } if $e->{clicked_may_quit}; + + create_widget($cui, $win, $e, $y, $sub_update->($e->{changed}), $sub_update->($e->{focus_out})); + $to_focus ||= $e if $e->{focus} && $e->{focus}->(); + $y += entry_height($e) if !$e->{same_line}; + } + + ($to_focus || $l->[-1])->{w}->focus; + + $set_all->(); + + $set_all; +} + +sub all_entries { + my ($l) = @_; + map { $_, if_($_->{children}, @{$_->{children}}) } @$l; +} + +sub ask_fromW { + my ($o, $common, $l) = @_; + ask_fromW_($o->{cui}, $common, $l); +} + +sub ask_fromW_ { + my ($cui, $common, $l) = @_; + + $l = [ filter_widgets($l) ]; + + my $set_all; + my $validate = sub { + my @all = all_entries($l); + my $e = find { $_->{validate} && !$_->{validate}->() } @all; + $e ||= $common->{validate} && !$common->{validate}() && $all[0]; + if ($e) { + $set_all->(); + $e->{w}->focus if $e->{w}; #- widget may not exist if it is inside an expander + } + !$e; + }; + + my @wanted_widgets = ( + if_(@{$common->{messages}}, { type => 'text', val => \(join("\n", @{$common->{messages}}, ' ')) }), + @$l, + { type => 'label', val => \ (my $_ignore) }, + compute_buttons($common, $validate), + ); + + compute_label_sizes($cui, $l); + my $labels_width = max(map { $_->{label_width} } @$l); + my $window_size; + eval { $window_size = compute_sizes($cui, \@wanted_widgets, $labels_width, 'first_time') } or do { + my ($nb) = $@ =~ /^too_many (\d+)$/ or die; + $nb -= 1; #- remove {messages} + $nb != @$l or internal_error("dead-loop detected"); + + my @l = ( + (@$l)[0 .. $nb - 1], + { type => 'expander', text => N("More"), children => [ (@$l)[$nb .. $#$l] ] }, + ); + return ask_fromW_($cui, $common, \@l); + }; + + my $win = $cui->add(undef, 'Window', + %$window_size, + '-border' => 1, + '-bfg' => 'blue', '-tfg' => 'yellow', '-tbg' => 'blue', '-titlereverse' => 0, + '-focusable' => 1, + if_($common->{title}, '-title' => $common->{title}), + ); + + $set_all = create_widgets($cui, $win, \@wanted_widgets); + + $win->set_binding(\&exit, "\cC"); + $win->set_binding(sub { suspend(); kill 19, $$ }, "\cZ"); + + $cui->focus($win, 1); + eval { $win->modalfocus }; + + my $err = $@; + $cui->delete_object($win); + $cui->draw; + + my ($v) = $err =~ /^exit_mainloop (\S*)/ or die $err; + + $v eq '0 but true' ? 0 : $v; +} + + +sub wait_messageW { + my ($o, $title, $message, $message_modifiable) = @_; + + my $w = { title => $title, message_header => $message }; + wait_message_nextW($o, $message_modifiable, $w); + $w; +} + +sub wait_message_nextW { + my ($o, $message, $w) = @_; + + wait_message_endW($o, $w) if $w->{w}; + my $msg = join("\n", _messages($o->{cui}{'-width'}, $w->{message_header} . "\n" . $message)); + $w->{w} = $o->{cui}->add(undef, 'Dialog::Status', '-title' => $w->{title}, '-message' => $msg); + $w->{w}->draw; +} +sub wait_message_endW { + my ($o, $w) = @_; + $o->{cui}->delete_object($w->{w}); + $o->{cui}->draw; +} + +sub wait_message_with_progress_bar { + my ($o, $o_title) = @_; + + my $w = {}; + my $b = before_leaving { $o->wait_message_endW($w) }; + $b, sub { + my ($msg, $current, $total) = @_; + if (!$w->{w} || $w->{total} != $total) { + $o->{cui}->delete_object($w->{w}) if $w->{w}; + + $w->{w} = $o->{cui}->add(undef, + $total ? ('Dialog::Progress', '-max' => $total) : 'Dialog::Status', + if_($o_title, '-title' => $o_title), + '-message' => $msg || $w->{msg}); + $w->{total} = $total; + $w->{msg} = $msg; + } elsif ($msg) { + $w->{w}->message($msg); + } + if ($current) { + $w->{w}->pos($current); + } + $o->{cui}->draw; + }; +} + +1; diff --git a/perl-install/interactive/gtk.pm b/perl-install/interactive/gtk.pm index e024fc54f..335bdda41 100644 --- a/perl-install/interactive/gtk.pm +++ b/perl-install/interactive/gtk.pm @@ -15,11 +15,16 @@ use Gtk2::Gdk::Keysyms; my $forgetTime = 1000; #- in milli-seconds sub new { - ($::windowwidth, $::windowheight) = gtkroot()->get_size if !$::isInstall; - goto &interactive::new; + my $w = &interactive::new; + ($w->{windowwidth}, $w->{windowheight}) = gtkroot()->get_size if !$::isInstall; + $w; } sub enter_console { my ($o) = @_; $o->{suspended} = common::setVirtual(1) } sub leave_console { my ($o) = @_; common::setVirtual(delete $o->{suspended}) } +sub adapt_markup { + #- nothing needed, the default markup is gtk2's + my ($_o, $s) = @_; return $s; +} sub exit { ugtk2::exit(@_) } @@ -38,7 +43,7 @@ sub ask_fileW { } sub create_boxradio { - my ($e, $may_go_to_next, $changed, $double_click) = @_; + my ($e, $onchange_f, $double_click) = @_; my $boxradio = gtkpack2__(Gtk2::VBox->new(0, 0), my @radios = gtkradio('', @{$e->{formatted_list}})); @@ -47,13 +52,11 @@ sub create_boxradio { my ($txt, $w) = @_; $w->signal_connect(button_press_event => $double_click) if $double_click; - $w->signal_connect(key_press_event => sub { - &$may_go_to_next; + $w->signal_connect(key_press_event => $e->{may_go_to_next}); + $w->signal_connect(clicked => sub { + ${$e->{val}} ne $txt or return; + $onchange_f->(sub { $txt }); }); - $w->signal_connect(clicked => sub { - ${$e->{val}} = $txt; - &$changed; - }); if ($e->{help}) { gtkset_tip($tips, $w, ref($e->{help}) eq 'HASH' ? $e->{help}{$txt} : @@ -71,7 +74,7 @@ sub create_boxradio { } sub create_treeview_list { - my ($e, $may_go_to_next, $changed, $double_click) = @_; + my ($e, $onchange_f, $double_click) = @_; my $curr; my $list = Gtk2::ListStore->new("Glib::String"); @@ -97,7 +100,7 @@ sub create_treeview_list { Glib::Source->remove($timeout) if $timeout; $timeout = ''; if ($event->keyval >= 0x100) { - &$may_go_to_next if member($event->keyval, ($Gtk2::Gdk::Keysyms{Return}, $Gtk2::Gdk::Keysyms{KP_Enter})); + $e->{may_go_to_next}(), return 1 if member($event->keyval, ($Gtk2::Gdk::Keysyms{Return}, $Gtk2::Gdk::Keysyms{KP_Enter})); $starting_word = '' if !member($event->keyval, ($Gtk2::Gdk::Keysyms{Control_L}, $Gtk2::Gdk::Keysyms{Control_R})); } else { if (member('control-mask', @{$event->state})) { @@ -105,7 +108,7 @@ sub create_treeview_list { $start_reg and $start_reg = '', return 1; $curr++; } else { - &$may_go_to_next if $c eq ' '; + $e->{may_go_to_next}(), return 1 if $c eq ' '; $curr++ if $starting_word eq '' || $starting_word eq $c; $starting_word .= $c unless $starting_word eq $c; @@ -132,9 +135,10 @@ sub create_treeview_list { $list_tv->get_selection->signal_connect(changed => sub { my ($model, $iter) = $_[0]->get_selected; $model && $iter or return; - my $row = $model->get_path_str($iter); - ${$e->{val}} = $e->{list}[$curr = $row]; - &$changed; + $onchange_f->(sub { + my $row = $model->get_path_str($iter); + $e->{list}[$curr = $row]; + }); }); $list_tv->signal_connect(button_press_event => $double_click) if $double_click; @@ -193,7 +197,7 @@ sub __create_tree_model { } sub create_treeview_tree { - my ($e, $may_go_to_next, $changed, $double_click, $tree_expanded) = @_; + my ($e, $onchange_f, $double_click) = @_; my $tree_model = __create_tree_model($e); my $tree = Gtk2::TreeView->new_with_model($tree_model); @@ -220,7 +224,7 @@ sub create_treeview_tree { }; my $curr = $tree_model->get_iter_first; #- default value - $tree->expand_all if $tree_expanded; + $tree->expand_all if $e->{tree_expanded}; my $selected_via_click; @@ -230,10 +234,11 @@ sub create_treeview_tree { undef $curr if ref $curr; my $path = $tree_model->get_path($curr = $iter); if (!$tree_model->iter_has_child($iter)) { - my $path_str = $path->to_string; - my $i = find_index { $path_str eq $_ } @{$tree_model->{path_str_list}}; - ${$e->{val}} = $e->{list}[$i]; - &$changed; + $onchange_f->(sub { + my $path_str = $path->to_string; + my $i = find_index { $path_str eq $_ } @{$tree_model->{path_str_list}}; + $e->{list}[$i]; + }); } else { $tree->expand_row($path, 0) if $selected_via_click; } @@ -246,7 +251,7 @@ sub create_treeview_tree { $tree->toggle_expansion($tree_model->get_path($curr), 0); } else { - &$may_go_to_next; + &{$e->{may_go_to_next}}; } }; @@ -259,7 +264,7 @@ sub create_treeview_tree { Glib::Source->remove($timeout) if $timeout; $timeout = ''; if ($event->keyval >= 0x100) { - &$toggle if member($event->keyval, ($Gtk2::Gdk::Keysyms{Return}, $Gtk2::Gdk::Keysyms{KP_Enter})); + &$toggle and return 1 if member($event->keyval, ($Gtk2::Gdk::Keysyms{Return}, $Gtk2::Gdk::Keysyms{KP_Enter})); $starting_word = '' if !member($event->keyval, ($Gtk2::Gdk::Keysyms{Control_L}, $Gtk2::Gdk::Keysyms{Control_R})); } else { my $next; @@ -268,7 +273,7 @@ sub create_treeview_tree { $start_reg and $start_reg = '', return 0; $next = 1; } else { - &$toggle if $c eq ' '; + &$toggle and return 1 if $c eq ' '; $next = 1 if $starting_word eq '' || $starting_word eq $c; $starting_word .= $c unless $starting_word eq $c; } @@ -322,50 +327,6 @@ sub create_treeview_tree { }; } -sub create_list { - my ($e, $may_go_to_next, $changed, $double_click) = @_; - my $l = $e->{list}; - my $list = Gtk2::List->new; - $list->set_selection_mode('browse'); - - my $select = sub { - $list->select_item($_[0]); - }; - - my $tips = Gtk2::Tooltips->new; - each_index { - my $item = Gtk2::ListItem->new(may_apply($e->{format}, $_)); - $item->signal_connect(key_press_event => sub { - my ($_w, $event) = @_; - my $c = chr($event->keyval & 0xff); - &$may_go_to_next if $event->keyval < 0x100 ? $c eq ' ' : $c eq "\r" || $c eq "\x8d"; - 0; - }); - $list->append_items(gtkshow($item)); - if ($e->{help}) { - gtkset_tip($tips, $item, - ref($e->{help}) eq 'HASH' ? $e->{help}{$_} : - ref($e->{help}) eq 'CODE' ? $e->{help}($_) : $e->{help}); - } - $item->grab_focus if ${$e->{val}} && $_ eq ${$e->{val}}; - } @$l; - - #- signal_connect'ed 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)]; - &$changed; - }); - $list->signal_connect(button_press_event => $double_click) if $double_click; - - $list, sub { - my ($v) = @_; - eval { - $select->(find_index { $_ eq $v } @$l); - }; - }; -} - #- $actions is a ref list of $action #- $action is a { kind => $kind, action => sub { ... }, button => Gtk2::Button->new(...) } #- where $kind is one of '', 'modify', 'remove', 'add' @@ -389,365 +350,447 @@ sub add_modify_remove_action { 1; } -sub add_modify_remove_sensitive { - my ($buttons, $e) = @_; - $_->{button}->set_sensitive(@{$e->{list}} != ()) foreach - grep { member($_->{kind}, 'modify', 'remove') } @$buttons; +sub create_widget { + my ($o, $e, $onchange_f, $update, $ignore_ref) = @_; + + my $onchange = sub { + my ($f) = @_; + sub { $onchange_f->($f, @_) }; + }; + + my ($w, $real_w, $focus_w, $set); + if ($e->{type} eq 'iconlist') { + $w = Gtk2::Button->new; + $set = sub { + gtkdestroy($e->{icon}); + my $f = $e->{icon2f}->($_[0]); + $e->{icon} = -e $f ? + gtkcreate_img($f) : + Gtk2::WrappedLabel->new(may_apply($e->{format}, $_[0])); + $w->add(gtkshow($e->{icon})); + }; + $w->signal_connect(clicked => sub { + $onchange_f->(sub { next_val_in_array(${$e->{val}}, $e->{list}) }); + $set->(${$e->{val}}); + }); + $real_w = gtkpack_(Gtk2::HBox->new(0,10), 1, Gtk2::HBox->new(0,0), 0, $w, 1, Gtk2::HBox->new(0,0)); + } elsif ($e->{type} eq 'bool') { + if ($e->{image}) { + $w = ugtk2::gtkadd(Gtk2::CheckButton->new, gtkshow(gtkcreate_img($e->{image}))); + } else { + #- warn "\"text\" member should have been used instead of \"label\" one at:\n", common::backtrace(), "\n" if $e->{label} && !$e->{text}; + $w = Gtk2::CheckButton->new_with_label($e->{text}); + } + $w->signal_connect(clicked => $onchange->(sub { $w->get_active })); + $set = sub { $w->set_active($_[0]) }; + } elsif ($e->{type} eq 'only_label') { + $w = $e->{title} ? + gtknew('Title2', label => escape_text_for_TextView_markup_format(${$e->{val}})) : + gtknew('Label_Left', line_wrap => 1, text_markup => ${$e->{val}}); + } elsif ($e->{type} eq 'label') { + $w = gtknew('WrappedLabel', text_markup => ${$e->{val}}); + $set = sub { $w->set($_[0]) }; + } elsif ($e->{type} eq 'empty') { + $w = gtknew('HBox', height => $e->{height}); + } elsif ($e->{type} eq 'button') { + $w = Gtk2::Button->new_with_label(''); + $w->signal_connect(clicked => $e->{clicked_may_quit_cooked}); + $set = sub { $w->child->set_label(may_apply($e->{format}, $_[0])) }; + } elsif ($e->{type} eq 'range') { + my $adj = Gtk2::Adjustment->new(${$e->{val}}, $e->{min}, $e->{max} + ($e->{SpinButton} ? 0 : 1), 1, ($e->{max} - $e->{min}) / 10, 1); + $w = $e->{SpinButton} ? Gtk2::SpinButton->new($adj, 10, 0) : Gtk2::HScale->new($adj); + $w->set_size_request($e->{SpinButton} ? 100 : 200, -1); + $w->set_digits(0); + $adj->signal_connect(value_changed => $onchange->(sub { $adj->get_value })); + $w->signal_connect(key_press_event => $e->{may_go_to_next}); + $set = sub { $adj->set_value($_[0]) }; + } elsif ($e->{type} eq 'expander') { + $e->{grow} = 'fill'; + my $children = [ if_($e->{message}, { type => 'only_label', no_indent => 1, val => \$e->{message} }), @{$e->{children}} ]; + my $box = create_widgets_block($o, $children, $update, $ignore_ref); + $w = gtknew('Expander', text => $e->{text}, child => $box); + } elsif ($e->{type} =~ /list/) { + + $e->{formatted_list} = [ map { may_apply($e->{format}, $_) } @{$e->{list}} ]; + + if (my $actions = $e->{add_modify_remove}) { + my @buttons = map { + { kind => lc $_, action => $actions->{$_}, button => Gtk2::Button->new(translate($_)) }; + } N_("Add"), N_("Modify"), N_("Remove"); + my $modify = find { $_->{kind} eq 'modify' } @buttons; + + my $do_action = sub { + my ($button) = @_; + add_modify_remove_action($button, \@buttons, $e, $w) and $update->(); + }; + + ($w, $set, $focus_w) = create_treeview_list($e, $onchange_f, + sub { $do_action->($modify) if $_[1]->type =~ /^2/ }); + + foreach my $button (@buttons) { + $button->{button}->signal_connect(clicked => sub { $do_action->($button) }); + } + add_modify_remove_sensitive(\@buttons, $e); + + $real_w = gtkpack_(Gtk2::HBox->new(0,0), + 1, create_scrolled_window($w), + 0, gtkpack__(Gtk2::VBox->new(0,0), map { $_->{button} } @buttons)); + $e->{grow} = 'expand'; + } else { + my $use_boxradio = exists $e->{gtk}{use_boxradio} ? $e->{gtk}{use_boxradio} : @{$e->{list}} <= 8; + + if ($e->{help} || $use_boxradio && $e->{type} ne 'treelist') { + #- used only when needed, as key bindings are dropped by List (ListStore does not seems to accepts Tooltips). + ($w, $set, $focus_w) = create_boxradio($e, $onchange_f, $e->{quit_if_double_click_cooked}); + } elsif ($e->{type} eq 'treelist') { + ($w, $set) = create_treeview_tree($e, $onchange_f, $e->{quit_if_double_click_cooked}); + } else { + ($w, $set, $focus_w) = create_treeview_list($e, $onchange_f, $e->{quit_if_double_click_cooked}); + } + if (@{$e->{list}} > 10 || $e->{gtk}{use_scrolling}) { + $real_w = create_scrolled_window($w); + $e->{grow} = 'expand'; + } + } + } else { + if ($e->{type} eq "combo") { + my $model; + + my @formatted_list = map { may_apply($e->{format}, $_) } @{$e->{list}}; + $e->{formatted_list} = \@formatted_list; + + my @l = sort { $b <=> $a } map { length } @formatted_list; + my $width = $l[@l / 16]; # take the third octile (think quartile) + + if (!$e->{separator}) { + if ($e->{not_edit} && $width < 160) { #- ComboBoxes do not have an horizontal scroll-bar. This can cause havoc for long strings (eg: diskdrake Create dialog box in expert mode) + $w = Gtk2::ComboBox->new_text; + $w->set_wrap_width($e->{gtk}{wrap_width}) if exists $e->{gtk}{wrap_width}; + } else { + $w = Gtk2::Combo->new; + $w->set_use_arrows_always(1); + $w->entry->set_editable(!$e->{not_edit}); + $w->disable_activate; + } + $w->set_popdown_strings(@formatted_list); + $w->set_text(ref($e->{val}) ? may_apply($e->{format}, ${$e->{val}}) : $formatted_list[0]) if $w->isa('Gtk2::ComboBox'); + } else { + $model = __create_tree_model($e); + $w = Gtk2::ComboBox->new_with_model($model); + + $w->pack_start(my $texrender = Gtk2::CellRendererText->new, 0); + $w->add_attribute($texrender, text => 0); + if ($e->{image2f}) { + $w->pack_start(my $pixrender = Gtk2::CellRendererPixbuf->new, 0); + $w->add_attribute($pixrender, pixbuf => 1); + } + } + ($real_w, $w) = ($w, $w->entry); + + my $get = sub { + my $i = $model ? do { + my $s = $model->get_string_from_iter($w->get_active_iter); + eval { find_index { $s eq $_ } @{$model->{path_str_list}} }; + } : do { + my $s = $w->get_text; + eval { find_index { $s eq $_ } @formatted_list }; + }; + defined $i ? $e->{list}[$i] : $w->get_text; + }; + if ($real_w->isa('Gtk2::Combo')) { + #- FIXME workaround gtk suckiness (set_text generates two 'change' signals, one when removing the whole, one for inserting the replacement..) + my $idle; + $w->signal_connect(changed => sub { + return if $$ignore_ref; + $idle ||= Glib::Idle->add(sub { undef $idle; $onchange_f->($get); 0 }); + }); + } else { + $w->signal_connect(changed => $onchange->($get)); + } + + $set = sub { + my $s = may_apply($e->{format}, $_[0]); + if ($model) { + eval { + my $i = find_index { $s eq $_ } @{$e->{formatted_list}}; + my $path_str = $model->{path_str_list}[$i]; + $w->set_active_iter($model->get_iter_from_string($path_str)); + }; + } else { + $w->set_text($s) if $s ne $w->get_text && $_[0] ne $w->get_text; + } + }; + } else { + $w = Gtk2::Entry->new; + $w->signal_connect(changed => $onchange->(sub { $w->get_text })); + $w->signal_connect(focus_in_event => sub { $w->select_region(0, -1) }); + $w->signal_connect(focus_out_event => sub { $w->select_region(0, 0) }); + $set = sub { $w->set_text($_[0]) if $_[0] ne $w->get_text }; + if ($e->{type} eq 'file') { + my $button = gtksignal_connect(Gtk2::Button->new_from_stock('gtk-open'), clicked => sub { + my $file = $o->ask_filename({ title => $e->{label} }); + $set->($file) if $file; + }); + $real_w = gtkpack_(Gtk2::HBox->new(0,0), 1, $w, 0, $button); + } + } + $w->signal_connect(key_press_event => $e->{may_go_to_next}); + $w->set_visibility(0) if $e->{hidden}; + } + + if (my $focus_out = $e->{focus_out}) { + $w->signal_connect(focus_out_event => sub { $update->($focus_out) }); + } + $real_w ||= $w; + + $e->{w} = $w; + $e->{real_w} = $real_w; + $e->{focus_w} = $focus_w || $w if $e->{type} ne 'empty'; + $e->{set} = $set || sub {}; } -sub ask_fromW { - my ($o, $common, $l, $l2) = @_; - my $ignore = 0; #-to handle recursivity +sub all_entries { + my ($l) = @_; + map { $_, if_($_->{children}, @{$_->{children}}) } @$l; +} - my $mainw = ugtk2->new($common->{title}, %$o, modal => 1, if__($::main_window, transient => $::main_window), if_($common->{icon}, icon => $common->{icon})); - - #-the widgets - my (@widgets, @widgets_always, @widgets_advanced, $advanced); - my $tooltips = Gtk2::Tooltips->new; - my $ok_clicked = sub { - !$mainw->{ok} || $mainw->{ok}->get_property('sensitive') or return; - $mainw->{retval} = 1; - Gtk2->main_quit; - }; +sub all_focusable_entries { + my ($l) = @_; + map { $_->{type} eq 'expander' + ? ($_->{w}->get_expanded ? all_focusable_entries($_->{children}) : ()) + : $_; + } grep { $_->{focus_w} } @$l; +} + +sub create_widgets_block { + my ($o, $l, $update, $ignore_ref) = @_; + + my $label_sizegrp = Gtk2::SizeGroup->new('horizontal'); + + @$l = map_index { + if ($::i && ($_->{type} eq 'expander' || $_->{title})) { + ({ type => 'empty', height => 4 }, $_); + } else { + $_; + } + } @$l; + + foreach my $e (@$l) { + my $onchange_f = sub { + my ($f, @para) = @_; + return if $$ignore_ref; + ${$e->{val}} = $f->(@para); + $update->($e->{changed}); + }; + + create_widget($o, $e, $onchange_f, $update, $ignore_ref); + + my $label_w; + if ($e->{label} || !$e->{no_indent}) { + $label_w = gtknew('Label_Left', text_markup => $e->{label} || '', + size_group => $label_sizegrp, alignment => [ 0, 0.5 ]); + } + + $e->{real_w} = gtkpack_(Gtk2::HBox->new, + if_($e->{icon}, 0, eval { gtkcreate_img($e->{icon}) }), + if_($label_w, 0, $label_w), + (1, $e->{real_w}), + ); + } + gtknew('VBox', children => [ map { $_->{grow} || 0, $_->{real_w} } @$l ]); +} + +sub create_widgets { + my ($o, $common, $mainw, $l) = @_; + + my $ignore = 0; #-to handle recursivity my $set_all = sub { $ignore = 1; - $_->{set}->(${$_->{e}{val}}, $_) foreach @widgets_always, @widgets_advanced; - $_->{real_w}->set_sensitive(!$_->{e}{disabled}()) foreach @widgets_always, @widgets_advanced; - $mainw->{ok}->set_sensitive(!$common->{callbacks}{ok_disabled}()) if $common->{callbacks}{ok_disabled}; + my @all = all_entries($l); + $_->{set}->(${$_->{val}}, $_) foreach @all; #- nb: the parameter "$_" is needed for create_boxradio + $_->{disabled} and $_->{real_w}->set_sensitive(!$_->{disabled}()) foreach @all; + $mainw->{ok}->set_sensitive(!$common->{ok_disabled}()) if $common->{ok_disabled}; $ignore = 0; }; - my $get_all = sub { - ${$_->{e}{val}} = $_->{get}->() foreach @widgets_always, @widgets_advanced; - }; my $update = sub { my ($f) = @_; return if $ignore; - $get_all->(); - $f->(); + $f->() if $f; $set_all->(); }; - my @label_sizegrp = map { Gtk2::SizeGroup->new('horizontal') } 0 .. 1; - my @realw_sizegrp = map { Gtk2::SizeGroup->new('horizontal') } 0 .. 1; + my $ok_clicked = sub { + !$mainw->{ok} || $mainw->{ok}->get_property('sensitive') or return; + $mainw->{retval} = 1; + Gtk2->main_quit; + }; - my $create_widget = sub { - my ($e, $ind) = @_; + my @all = all_entries($l); + foreach (@all) { + my $e = $_; #- for closures - my $may_go_to_next = sub { - my (undef, $event) = @_; - if (!$event || ($event->keyval & 0x7f) == 0xd) { - if ($ind == $#widgets) { - @widgets == 1 ? $ok_clicked->() : $mainw->{ok}->grab_focus; - } else { - $widgets[$ind+1]{focus_w}->grab_focus; - } - return 1; #- prevent an action on the just grabbed focus - } - }; - my $changed = sub { $update->(sub { $common->{callbacks}{changed}($ind) }) }; + if (@all == 1 || $e->{quit_if_double_click}) { + #- i'm the only one, double click means accepting + $e->{quit_if_double_click_cooked} = sub { $_[1]->type =~ /^2/ && $ok_clicked->() }; + } - my ($w, $real_w, $focus_w, $set, $get, $grow); - if ($e->{type} eq 'iconlist') { - $w = Gtk2::Button->new; - $set = sub { - gtkdestroy($e->{icon}); - my $f = $e->{icon2f}->($_[0]); - $e->{icon} = -e $f ? - gtkcreate_img($f) : - Gtk2::WrappedLabel->new(may_apply($e->{format}, $_[0])); - $w->add(gtkshow($e->{icon})); - }; - $w->signal_connect(clicked => sub { - $set->(${$e->{val}} = next_val_in_array(${$e->{val}}, $e->{list})); - $changed->(); - }); - $real_w = gtkpack_(Gtk2::HBox->new(0,10), 1, Gtk2::HBox->new(0,0), 0, $w, 1, Gtk2::HBox->new(0,0)); - } elsif ($e->{type} eq 'bool') { - if ($e->{image}) { - $w = ugtk2::gtkadd(Gtk2::CheckButton->new, gtkshow(gtkcreate_img($e->{image}))); - } else { -#- warn "\"text\" member should have been used instead of \"label\" one at:\n", common::backtrace(), "\n" if $e->{label} && !$e->{text}; - $w = Gtk2::CheckButton->new_with_label($e->{text}); - } - $w->signal_connect(clicked => $changed); - $set = sub { $w->set_active($_[0]) }; - $get = sub { $w->get_active }; - } elsif ($e->{type} eq 'label') { - $w = Gtk2::WrappedLabel->new(${$e->{val}}); - $set = sub { $w->set($_[0]) }; - } elsif ($e->{type} eq 'button') { - $w = Gtk2::Button->new_with_label(''); - $w->signal_connect(clicked => sub { - $get_all->(); + if ($e->{clicked_may_quit}) { + $e->{clicked_may_quit_cooked} = sub { $mainw->{rwindow}->hide; if (my $v = $e->{clicked_may_quit}()) { $mainw->{retval} = $v; Gtk2->main_quit; } $mainw->{rwindow}->show; - $set_all->(); - }); - $set = sub { $w->child->set_label(may_apply($e->{format}, $_[0])) }; - } elsif ($e->{type} eq 'range') { - my $want_scale = !$::expert; - my $adj = Gtk2::Adjustment->new(${$e->{val}}, $e->{min}, $e->{max} + ($want_scale ? 1 : 0), 1, ($e->{max} - $e->{min}) / 10, 1); - $adj->signal_connect(value_changed => $changed); - $w = $want_scale ? Gtk2::HScale->new($adj) : Gtk2::SpinButton->new($adj, 10, 0); - $w->set_size_request($want_scale ? 200 : 100, -1); - $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} =~ /list/) { - - $e->{formatted_list} = [ map { may_apply($e->{format}, $_) } @{$e->{list}} ]; - - if (my $actions = $e->{add_modify_remove}) { - my @buttons = map { - { kind => lc $_, action => $actions->{$_}, button => Gtk2::Button->new(translate($_)) }; - } N_("Add"), N_("Modify"), N_("Remove"); - my $modify = find { $_->{kind} eq 'modify' } @buttons; - - my $do_action = sub { - my ($button) = @_; - add_modify_remove_action($button, \@buttons, $e, $w) and $changed->(); - }; - - ($w, $set, $focus_w) = create_treeview_list($e, $may_go_to_next, $changed, - sub { $do_action->($modify) if $_[1]->type =~ /^2/ }); - $e->{saved_default_val} = ${$e->{val}}; + $update->(); + }; + } - foreach my $button (@buttons) { - $button->{button}->signal_connect(clicked => sub { $do_action->($button) }); + $e->{may_go_to_next} = sub { + my (undef, $event) = @_; + if (!$event || ($event->keyval & 0x7f) == 0xd) { + my @current_all = all_focusable_entries($l); + my $ind = eval { find_index { $_ == $e } @current_all }; + if (my $e_ = $current_all[$ind+1]) { + $e_->{focus_w}->grab_focus; + } else { + @current_all == 1 ? $ok_clicked->() : $mainw->{ok}->grab_focus; } - add_modify_remove_sensitive(\@buttons, $e); - - $real_w = gtkpack_(Gtk2::HBox->new(0,0), - 1, create_scrolled_window($w), - 0, gtkpack__(Gtk2::VBox->new(0,0), map { $_->{button} } @buttons)); - $grow = 1; + 1; #- prevent an action on the just grabbed focus } else { + 0; + } + }; + } - my $quit_if_double_click = - #- i'm the only one, double click means accepting - @$l == 1 || $e->{quit_if_double_click} ? - sub { $_[1]->type =~ /^2/ && $ok_clicked->() } : ''; + my $box = create_widgets_block($o, $l, $update, \$ignore); - my @para = ($e, $may_go_to_next, $changed, $quit_if_double_click); - my $use_boxradio = exists $e->{gtk}{use_boxradio} ? $e->{gtk}{use_boxradio} : @{$e->{list}} <= 8; + my $tooltips = Gtk2::Tooltips->new; + foreach my $e (@all) { + $tooltips->set_tip($e->{w}, $e->{help}) if $e->{help} && !ref($e->{help}); + } - if ($e->{help}) { - #- used only when needed, as key bindings are dropped by List (ListStore does not seems to accepts Tooltips). - ($w, $set, $focus_w) = $use_boxradio ? create_boxradio(@para) : create_list(@para); - } elsif ($e->{type} eq 'treelist') { - ($w, $set) = create_treeview_tree(@para, $e->{tree_expanded}); - $e->{saved_default_val} = ${$e->{val}}; #- during realization, signals will mess up the default val :( - } else { - if ($use_boxradio) { - ($w, $set, $focus_w) = create_boxradio(@para); - } else { - ($w, $set, $focus_w) = create_treeview_list(@para); - $e->{saved_default_val} = ${$e->{val}}; - } - } - if (@{$e->{list}} > 10) { - $real_w = create_scrolled_window($w); - $grow = 1; - } - } - } else { - if ($e->{type} eq "combo") { - my $model; + $box, $set_all; +} - my @formatted_list = map { may_apply($e->{format}, $_) } @{$e->{list}}; - $e->{formatted_list} = \@formatted_list; +sub add_modify_remove_sensitive { + my ($buttons, $e) = @_; + $_->{button}->set_sensitive(@{$e->{list}} != ()) foreach + grep { member($_->{kind}, 'modify', 'remove') } @$buttons; +} - my @l = sort { $b <=> $a } map { length } @formatted_list; - my $width = $l[@l / 16]; # take the third octile (think quartile) +sub filter_widgets { + my ($l) = @_; - if (!$e->{separator}) { - if ($e->{not_edit} && $width < 160) { #- ComboBoxes do not have an horizontal scroll-bar. This can cause havoc for long strings (eg: diskdrake Create dialog box in expert mode) - $w = Gtk2::ComboBox->new_text; - } else { - $w = Gtk2::Combo->new; - $w->set_use_arrows_always(1); - $w->entry->set_editable(!$e->{not_edit}); - $w->disable_activate; - } - $w->set_popdown_strings(@formatted_list); - $w->set_text(ref($e->{val}) ? may_apply($e->{format}, ${$e->{val}}) : $formatted_list[0]) if $w->isa('Gtk2::ComboBox'); - } else { - $model = __create_tree_model($e); - $w = Gtk2::ComboBox->new_with_model($model); - - $w->pack_start(my $texrender = Gtk2::CellRendererText->new, 0); - $w->add_attribute($texrender, text => 0); - if ($e->{image2f}) { - $w->pack_start(my $pixrender = Gtk2::CellRendererPixbuf->new, 0); - $w->add_attribute($pixrender, pixbuf => 1); - } - } - ($real_w, $w) = ($w, $w->entry); + foreach my $e (all_entries($l)) { + $e->{no_indent} = 1 if member($e->{type}, 'list', 'treelist', 'expander', 'bool', 'only_label'); + } +} - #- FIXME workaround gtk suckiness (set_text generates two 'change' signals, one when removing the whole, one for inserting the replacement..) - my $idle; - $w->signal_connect(changed => sub { - $idle ||= Glib::Idle->add(sub { undef $idle; $changed->(); 0 }); - }); - - $set = sub { - my $s = may_apply($e->{format}, $_[0]); - if ($model) { - eval { - my $i = find_index { $s eq $_ } @{$e->{formatted_list}}; - my $path_str = $model->{path_str_list}[$i]; - $w->set_active_iter($model->get_iter_from_string($path_str)); - }; - } else { - $w->set_text($s) if $s ne $w->get_text && $_[0] ne $w->get_text; - } - }; - $get = sub { - my $i = $model ? do { - my $s = $model->get_string_from_iter($w->get_active_iter); - eval { find_index { $s eq $_ } @{$model->{path_str_list}} }; - } : do { - my $s = $w->get_text; - eval { find_index { $s eq $_ } @formatted_list }; - }; - defined $i ? $e->{list}[$i] : $w->get_text; - }; - } else { - $w = Gtk2::Entry->new; - $w->signal_connect(changed => $changed); - $w->signal_connect(focus_in_event => sub { $w->select_region(0, -1) }); - $w->signal_connect(focus_out_event => sub { $w->select_region(0, 0) }); - $set = sub { $w->set_text($_[0]) if $_[0] ne $w->get_text }; - $get = sub { $w->get_text }; - } - $w->signal_connect(key_press_event => $may_go_to_next); - $w->set_visibility(0) if $e->{hidden}; - } - $w->signal_connect(focus_out_event => sub { - $update->(sub { $common->{callbacks}{focus_out}($ind) }); - }); - $tooltips->set_tip($w, $e->{help}) if $e->{help} && !ref($e->{help}); +my $help_path = "/usr/share/doc/installer-help"; - $real_w ||= $w; - $real_w = gtkpack_(Gtk2::HBox->new, - if_($e->{icon}, 0, eval { gtkcreate_img($e->{icon}) }), - 0, gtkadd_widget($label_sizegrp[$e->{advanced} ? 1 : 0], $e->{label}), - 1, gtkadd_widget($realw_sizegrp[$e->{advanced} ? 1 : 0], $real_w), - ) if !$real_w->isa("Gtk2::CheckButton") || $e->{icon} || $e->{label}; +sub load_from_uri { + my ($document, $url) = @_; + $url = "$help_path/$url" if $url !~ m!^/!; + my $str = scalar(cat_($url)); + c::set_tagged_utf8($str); + $document->clear; + $document->open_stream("text/html"); + $document->write_stream($str); +} - { e => $e, w => $w, real_w => $real_w, focus_w => $focus_w || $w, - get => $get || sub { ${$e->{val}} }, set => $set || sub {}, grow => $grow }; - }; - @widgets_always = map_index { $create_widget->($_, $::i) } @$l; - @widgets_advanced = map_index { $create_widget->($_, $::i + @$l) } @$l2; +sub ask_fromW { + my ($o, $common, $l) = @_; + + filter_widgets($l); + + my $mainw = ugtk2->new($common->{title}, %$o, modal => 1, if__($::main_window, transient => $::main_window, modal => 1), + if_($common->{icon}, icon => $common->{icon}), banner_title => $common->{banner_title}, + ); + + my ($box, $set_all) = create_widgets($o, $common, $mainw, $l); $mainw->{box_allow_grow} = 1; my $pack = create_box_with_title($mainw, @{$common->{messages}}); - mygtk2::set_main_window_size($mainw->{rwindow}) if $mainw->{pop_it} && (@$l || $mainw->{box_size} == 200); - - my @before_widgets_advanced = ( - (map { { grow => 0, real_w => Gtk2::WrappedLabel->new($_) } } @{$common->{advanced_messages}}), - { grow => 0, real_w => Gtk2::HSeparator->new }, - ); - - my $first_time = 1; - my $set_advanced = sub { - ($advanced) = @_; - $update->($common->{callbacks}{advanced}) if $advanced && !$first_time; - foreach (@before_widgets_advanced, @widgets_advanced) { - my $w = $_->{embed_scroll} || $_->{real_w}; - $advanced ? $w->show : $w->hide; - } - @widgets = (@widgets_always, if_($advanced, @widgets_advanced)); - $first_time = 0; - $set_all->(); #- must be done when showing advanced lists (to center selected value) - }; - if ($::expert && @$l2) { - $common->{advanced_state} = 1; - } - my $advanced_button = [ $common->{advanced_state} ? $common->{advanced_label_close} : $common->{advanced_label}, - sub { - my ($w) = @_; - $set_advanced->(!$advanced); - $w->child->set_label($advanced ? $common->{advanced_label_close} : $common->{advanced_label}); - } ]; + mygtk2::set_main_window_size($mainw->{rwindow}) if $mainw->{pop_it} && !$common->{auto_window_size} && (@$l || $mainw->{box_size} == 200); my @more_buttons = ( if_($common->{interactive_help}, [ N("Help"), sub { + if (my $file = find { -e $_ } map { "$help_path/${_}.html" } + map { + my $id = $_; + require lang; + map { "$_/$id" } (split ':', lang::getLANGUAGE($o->{locale}{lang})); + } $common->{interactive_help_id} + ) { + require Gtk2::Html2; + my $view = Gtk2::Html2::View->new; + my $document = Gtk2::Html2::Document->new; + $document->signal_connect(request_url => sub { + my ($_document, $url, $stream) = @_; + $stream->write(join('', cat_("$help_path/$url"))); + $stream->close; + }); + $document->signal_connect('link-clicked' => \&load_from_uri); + $view->set_document($document); + + load_from_uri($document, $file); + + my $w = ugtk2->new(N("Help"), transient => $mainw->{real_window}, modal => 1); + gtkadd($w->{rwindow}, + gtkpack_(Gtk2::VBox->new, + 1, create_scrolled_window(gtkset_border_width($view, 5), + [ 'never', 'automatic' ], + ), + 0, gtkpack(create_hbox('edge'), + gtknew('Button', text => N("Close"), clicked => sub { Gtk2->main_quit }) + ), + ), + ); + # make parent visible still visible: + local ($::real_windowwidth, $::real_windowheight) = ($::real_windowwidth - 50, $::real_windowheight - 50); + mygtk2::set_main_window_size($w->{rwindow}); + $w->{real_window}->grab_focus; + $w->{real_window}->show_all; + $w->main; + return; + } my $message = $common->{interactive_help}->() or return; $o->ask_warn(N("Help"), $message); }, 1 ]), if_($common->{more_buttons}, @{$common->{more_buttons}}), ); - my $buttons_pack = ($common->{ok} || !exists $common->{ok}) && $mainw->create_okcancel($common->{ok}, $common->{cancel}, '', @more_buttons, if_(@$l2, $advanced_button)); - - my @widgets_to_pack; - foreach my $l (\@widgets_always, if_(@widgets_advanced, [ @before_widgets_advanced, @widgets_advanced ])) { - my @grouped; - my $add_grouped = sub { - if (@grouped == 0) { - } elsif (@grouped == 1) { - push @widgets_to_pack, 0 => $grouped[0]{real_w}; - } else { - my $scroll = create_scrolled_window(gtkpack__(Gtk2::VBox->new(0,0), map { $_->{real_w} } @grouped), - [ 'automatic', 'automatic' ], 'none'); - $_->{embed_scroll} = $scroll foreach @grouped; - push @widgets_to_pack, 1 => $scroll; - } - @grouped = (); - }; - foreach (@$l) { - if ($_->{grow}) { - $add_grouped->(); - push @widgets_to_pack, 1 => $_->{real_w}; - } else { - push @grouped, $_; - } - } - $add_grouped->(); - } + my $buttons_pack = ($common->{ok} || !exists $common->{ok}) && $mainw->create_okcancel($common->{ok}, $common->{cancel}, '', @more_buttons); - gtkpack_($pack, @widgets_to_pack); + gtkpack_($pack, 1, gtknew('ScrolledWindow', shadow_type => 'none', child => $box)) if @$l; if ($buttons_pack) { $pack->pack_end(gtkshow($buttons_pack), 0, 0, 0); } ugtk2::gtkadd($mainw->{window}, $pack); - $set_advanced->($common->{advanced_state}); - - my $widget_to_focus = - $common->{focus_cancel} ? $mainw->{cancel} : - @widgets && ($common->{focus_first} || !$mainw->{ok} || @widgets == 1 && member(ref($widgets[0]{focus_w}), "Gtk2::TreeView", "Gtk2::RadioButton")) ? - $widgets[0]{focus_w} : - $mainw->{ok}; + $set_all->(); + + my $entry_to_focus = find { $_->{focus} && $_->{focus}() } @$l; + my $widget_to_focus = $entry_to_focus ? $entry_to_focus->{focus_w} : + $common->{focus_cancel} ? $mainw->{cancel} : + @$l && (!$mainw->{ok} || @$l == 1 && member(ref($l->[0]{focus_w}), "Gtk2::TreeView", "Gtk2::RadioButton")) ? + $l->[0]{focus_w} : + $mainw->{ok}; $widget_to_focus->grab_focus if $widget_to_focus; - my $check = sub { - my ($f) = @_; - sub { - $get_all->(); - my ($error, $focus) = $f->(); - - if ($error) { - $set_all->(); - if (my $to_focus = $widgets[$focus || 0]) { - $to_focus->{focus_w}->grab_focus; - } else { - log::l("ERROR: bad entry number given to focus " . backtrace()); - } - } - !$error; - }; + my $validate = sub { + my @all = all_entries($l); + my $e = find { $_->{validate} && !$_->{validate}->() } @all; + $e ||= $common->{validate} && !$common->{validate}() && $all[0]; + if ($e) { + $set_all->(); + $e->{focus_w}->grab_focus; + } + !$e; }; - $_->{set}->($_->{e}{saved_default_val} || next) foreach @widgets_always, @widgets_advanced; - $mainw->main(map { $check->($common->{callbacks}{$_}) } 'complete', 'canceled'); + $mainw->main($validate); } @@ -770,18 +813,21 @@ sub ask_from__add_modify_removeW { } sub wait_messageW { - my ($_o, $title, $messages) = @_; + my ($o, $title, $message, $message_modifiable) = @_; - my $to_modify; - my @l = map { ref $_ ? (0, $_) : (1, $to_modify = Gtk2::Label->new(scalar warp_text($_))) } @$messages; - $l[0] = 0; #- force first one + my $to_modify = Gtk2::Label->new(scalar warp_text(ref $message_modifiable ? '' : $message_modifiable)); my $Window = gtknew('MagicWindow', title => $title, pop_it => !$::isInstall, modal => 1, + no_Window_Manager => exists $o->{no_Window_Manager} ? $o->{no_Window_Manager} : !$::isStandalone, if__($::main_window, transient_for => $::main_window), - child => gtknew('VBox', padding => 4, border_width => 10, children => \@l), + child => gtknew('VBox', padding => 4, border_width => 10, children => [ + 0, Gtk2::Label->new(scalar warp_text($message)), + 1, $to_modify, + if_(ref($message_modifiable), 0, $message_modifiable), + ]), ); $Window->signal_connect(expose_event => sub { $Window->{displayed} = 1; 0 }); $Window->{wait_messageW} = $to_modify; @@ -789,11 +835,10 @@ sub wait_messageW { $Window; } sub wait_message_nextW { - my ($_o, $messages, $Window) = @_; - my $msg = warp_text(join "\n", @$messages); - return if $msg eq $Window->{wait_messageW}->get_text; #- needed otherwise no expose_event :( + my ($_o, $message, $Window) = @_; + return if $message eq $Window->{wait_messageW}->get_text; #- needed otherwise no expose_event :( $Window->{displayed} = 0; - $Window->{wait_messageW}->set($msg); + $Window->{wait_messageW}->set($message); mygtk2::sync($Window) while !$Window->{displayed}; } sub wait_message_endW { @@ -802,6 +847,31 @@ sub wait_message_endW { mygtk2::flush(); } +sub wait_message_with_progress_bar { + my ($in, $o_title) = @_; + + my $progress = Gtk2::ProgressBar->new; + my $w = $in->wait_message($o_title, $progress); + my $displayed; + $progress->signal_connect(expose_event => sub { $displayed = 1; 0 }); + $w, sub { + my ($msg, $current, $total) = @_; + if ($msg) { + $w->set($msg); + } + + if ($total) { + $progress or internal_error('You must first give some text to display'); + $progress->set_fraction($current / $total); + $progress->show; + $displayed = 0; + mygtk2::flush() while !$displayed; + } else { + $progress->hide if !$total; + } + }; +} + sub kill { my ($_o) = @_; $_->destroy foreach $::WizardTable ? $::WizardTable->get_children : (), @tempory::objects; diff --git a/perl-install/interactive/http.pm b/perl-install/interactive/http.pm index 6825ee007..52372ab7a 100644 --- a/perl-install/interactive/http.pm +++ b/perl-install/interactive/http.pm @@ -136,15 +136,15 @@ sub p { } sub wait_messageW { - my ($_o, $_title, $messages) = @_; + my ($_o, $_title, $message, $message_modifiable) = @_; cont_stdout(); print "\n" . CGI::p(); - p(@$messages); + p($message, $message_modifiable); } sub wait_message_nextW { - my ($_o, $messages, $_w) = @_; - p(@$messages); + my ($_o, $message, $_w) = @_; + p($message); } sub wait_message_endW { my ($_o, $_w) = @_; diff --git a/perl-install/interactive/newt.pm b/perl-install/interactive/newt.pm deleted file mode 100644 index d42eb99d8..000000000 --- a/perl-install/interactive/newt.pm +++ /dev/null @@ -1,423 +0,0 @@ -package interactive::newt; # $Id$ - -use diagnostics; -use strict; -use vars qw(@ISA); - -@ISA = qw(interactive); - -use interactive; -use common; -use log; -use Newt::Newt; #- !! provides Newt and not Newt::Newt - -my ($width, $height) = (80, 25); -my @wait_messages; - -sub new { - if ($::isInstall) { - system('unicode_start'); #- do not use run_program, we must do it on current console - { - local $ENV{LC_CTYPE} = "en_US.UTF-8"; - Newt::Init(1); - } - c::init_setlocale(); - } else { - Newt::Init(0); - } - Newt::Cls(); - Newt::SetSuspendCallback(); - ($width, $height) = Newt::GetScreenSize(); - open STDERR, ">/dev/null" if $::isStandalone && !$::testing; - bless {}, $_[0]; -} - -sub enter_console { Newt::Suspend() } -sub leave_console { Newt::Resume() } -sub suspend { Newt::Suspend() } -sub resume { Newt::Resume() } -sub end { Newt::Finished() } -sub exit { end(); exit($_[1]) } -END { end() } - -sub messages { - my ($width, @messages) = @_; - warp_text(join("\n", @messages), $width - 9); -} - -sub myTextbox { - my ($allow_scroll, $free_height, @messages) = @_; - - my @l = messages($width, @messages); - my $h = min($free_height - 13, int @l); - - my $want_scroll; - if ($h < @l) { - if ($allow_scroll) { - $want_scroll = 1; - } else { - # remove the text, no other way! - @l = @l[0 .. $h-1]; - } - } - - my $mess = Newt::Component::Textbox(1, 0, my $w = max(map { length } @l) + 1, $h, $want_scroll); - $mess->TextboxSetText(join("\n", @l)); - $mess, $w + 1, $h; -} - -sub separator { - my $blank = Newt::Component::Form(\undef, '', 0); - $blank->FormSetWidth($_[0]); - $blank->FormSetHeight($_[1]); - $blank; -} -sub checkval { $_[0] && $_[0] ne ' ' ? '*' : ' ' } - -sub ask_fromW { - my ($o, $common, $l, $l2) = @_; - - if (@$l == 1 && $l->[0]{list} && @{$l->[0]{list}} == 2 && listlength(map { split "\n" } @{$common->{messages}}) > 20) { - #- special ugly case, esp. for license agreement - my $e = $l->[0]; - my $ok_disabled = $common->{callbacks} && delete $common->{callbacks}{ok_disabled}; - ($common->{ok}, $common->{cancel}) = map { may_apply($e->{format}, $_) } @{$e->{list}}; - do { - ${$e->{val}} = ask_fromW_real($o, $common, [], $l2) ? $e->{list}[0] : $e->{list}[1]; - } while $ok_disabled && $ok_disabled->(); - 1; - } elsif ((any { $_->{type} ne 'button' } @$l) || @$l < 5) { - &ask_fromW_real; - } else { - $common->{cancel} = N("Do") if $common->{cancel} eq ''; - my $r; - do { - my @choices = map { - my $s = simplify_string(may_apply($_->{format}, ${$_->{val}})); - $s = "$_->{label}: $s" if $_->{label}; - { label => $s, clicked_may_quit => $_->{clicked_may_quit} }; - } @$l; - #- replace many buttons with a list - my $new_l = [ { val => \$r, type => 'list', list => \@choices, format => sub { $_[0]{label} }, sort => 0 } ]; - ask_fromW_real($o, $common, $new_l, $l2) and return; - } until $r->{clicked_may_quit}->(); - 1; - } -} - -sub ask_fromW_real { - my ($o, $common, $l, $l2) = @_; - my $ignore; #-to handle recursivity - my $old_focus = -2; - - my @l = $common->{advanced_state} ? @$l2 : @$l; - my @messages = (@{$common->{messages}}, if_($common->{advanced_state}, @{$common->{advanced_messages}})); - - #-the widgets - my (@widgets, $total_size, $has_scroll); - - my $label_width; - my $get_label_width = sub { - $label_width ||= max(map { length($_->{label}) } @l); - }; - - my $set_all = sub { - $ignore = 1; - $_->{set}->(${$_->{e}{val}}) foreach @widgets; -# $_->{w}->set_sensitive(!$_->{e}{disabled}()) foreach @widgets; - $ignore = 0; - }; - my $get_all = sub { - ${$_->{e}{val}} = $_->{get}->() foreach @widgets; - }; - my $create_widget = sub { - my ($e, $ind) = @_; - - $e->{type} = 'list' if $e->{type} =~ /iconlist/; - - #- combo does not exist, fallback to a sensible default - $e->{type} = $e->{not_edit} ? 'list' : 'entry' if $e->{type} eq 'combo'; - - my $changed = sub { - return if $ignore; - return $old_focus++ if $old_focus == -2; #- handle special first case - $get_all->(); - - #- TODO: this is very rough :( - $common->{callbacks}{$old_focus == $ind ? 'changed' : 'focus_out'}->($ind); - - $set_all->(); - $old_focus = $ind; - }; - - my ($w, $real_w, $set, $get, $expand, $size, $invalid_choice, $extra_text); - if ($e->{type} eq 'bool') { - my $subwidth = $width - $get_label_width->() - 9; - my @text = messages($subwidth, $e->{text} || ''); - $size = @text; - $w = Newt::Component::Checkbox(shift(@text), checkval(${$e->{val}}), " *"); - if (@text) { - $extra_text = Newt::Component::Textbox(-1, -1, $subwidth, $size - 1, 0); - $extra_text->TextboxSetText(join("\n", @text)); - } - $set = sub { $w->CheckboxSetValue(checkval($_[0])) }; - $get = sub { $w->CheckboxGetValue == ord '*' }; - } elsif ($e->{type} eq 'button') { - $w = Newt::Component::Button(simplify_string(may_apply($e->{format}, ${$e->{val}}))); - } elsif ($e->{type} eq 'treelist') { - $e->{formatted_list} = [ map { may_apply($e->{format}, $_) } @{$e->{list}} ]; - my $data_tree = interactive::helper_separator_tree_to_tree($e->{separator}, $e->{list}, $e->{formatted_list}); - - my $count; $count = sub { - my ($t) = @_; - 1 + ($t->{_leaves_} ? int @{$t->{_leaves_}} : 0) - + ($t->{_order_} ? sum(map { $count->($t->{$_}) } @{$t->{_order_}}) : 0); - }; - $size = $count->($data_tree); - - my $prefered_size = @l == 1 && $height > 30 ? 10 : 5; - my $scroll; - if ($size > $prefered_size && !$o->{no_individual_scroll}) { - $has_scroll = $scroll = 1; - $size = $prefered_size; - } - - $w = Newt::Component::Tree($size, $scroll); - - my $wi; - my $add_item = sub { - my ($text, $index, $parents) = @_; - $text = simplify_string($text, $width - 10); - $wi = max($wi, length($text) + 3 * @$parents + 4); - $w->TreeAdd($text, $index, $parents); - }; - - my @data = ''; - my $populate; $populate = sub { - my ($node, $parents) = @_; - if (my $l = $node->{_order_}) { - each_index { - $add_item->($_, 0, $parents); - $populate->($node->{$_}, [ @$parents, $::i ]); - } @$l; - } - if (my $l = $node->{_leaves_}) { - foreach (@$l) { - my ($leaf, $data) = @$_; - $add_item->($leaf, int(@data), $parents); - push @data, $data; - } - } - }; - $populate->($data_tree, []); - - $w->TreeSetWidth($wi + 1); - $get = sub { - my $i = $w->TreeGetCurrent; - $invalid_choice = $i == 0; - $data[$i]; - }; - $set = sub { - my ($data) = @_; - eval { - my $i = find_index { $_ eq $data } @data; - $w->TreeSetCurrent($i); - } if $data; - 1; - }; - } elsif ($e->{type} =~ /list/) { - $size = @{$e->{list}}; - my $prefered_size = @l == 1 && $height > 30 ? 10 : 5; - my $scroll; - if ($size > $prefered_size && !$o->{no_individual_scroll}) { - $has_scroll = $scroll = 1; - $size = $prefered_size; - } - - $w = Newt::Component::Listbox($size, $scroll ? 1 << 2 : 0); #- NEWT_FLAG_SCROLL - - my @l = map { - my $t = simplify_string(may_apply($e->{format}, $_), $width - 10); - $w->ListboxAddEntry($t, $_); - $t; - } @{$e->{list}}; - - $w->ListboxSetWidth(max(map { length($_) } @l) + 3); # 3 added for the scrollbar (?) - $get = sub { $w->ListboxGetCurrent }; - $set = sub { - my ($val) = @_; - each_index { - $w->ListboxSetCurrent($::i) if $val eq $_; - } @{$e->{list}}; - }; - } else { - $w = Newt::Component::Entry('', 20, ($e->{hidden} && 1 << 11) | (1 << 2)); - $get = sub { $w->EntryGetValue }; - $set = sub { $w->EntrySet($_[0], 1) }; - } - $total_size += $size || 1; - - #- !! callbacks must be kept otherwise perl will free them !! - #- (better handling of addCallback needed) - - { e => $e, w => $w, real_w => $real_w || $w, expand => $expand, callback => $changed, - get => $get || sub { ${$e->{val}} }, set => $set || sub {}, - extra_text => $extra_text, invalid_choice => \$invalid_choice }; - }; - @widgets = map_index { $create_widget->($_, $::i) } @l; - - $_->{w}->addCallback($_->{callback}) foreach @widgets; - - $set_all->(); - - my $grid = Newt::Grid::CreateGrid(3, max(1, sum(map { $_->{extra_text} ? 2 : 1 } @widgets))); - my $i; - foreach (@widgets) { - $grid->GridSetField(0, $i, 1, ${Newt::Component::Label($_->{e}{label})}, 0, 0, 1, 0, 1, 0); - $grid->GridSetField(1, $i, 1, ${$_->{real_w}}, 0, 0, 0, 0, 1, 0); - $i++; - if ($_->{extra_text}) { - $grid->GridSetField(0, $i, 1, ${Newt::Component::Label('')}, 0, 0, 1, 0, 1, 0); - $grid->GridSetField(1, $i, 1, ${$_->{extra_text}}, 0, 0, 0, 0, 1, 0); - $i++; - } - } - - my $listg = do { - my $wanted_header_height = min(8, listlength(messages($width, @messages))); - my $height_avail = $height - $wanted_header_height - 13; - #- use a scrolled window if there is a lot of checkboxes (aka - #- ask_many_from_list) or a lot of widgets in general (aka - #- options of a native PostScript printer in printerdrake) - #- !! works badly together with list's (lists are one widget, so a - #- big list window will not switch to scrollbar mode) :-( - if (@l > 3 && $total_size > $height_avail) { - $grid->GridPlace(1, 1); #- Uh?? otherwise the size allocated is bad - if ($has_scroll) { - #- trying again with no_individual_scroll set - $o->{no_individual_scroll} and internal_error('no_individual_scroll already set, argh...'); - $o->{no_individual_scroll} = 1; - goto &ask_fromW_real; #- same player shoot again! - } - $has_scroll = 1; - $total_size = $height_avail; - - my $scroll = Newt::Component::VerticalScrollbar($height_avail, 9, 10); # 9=NEWT_COLORSET_CHECKBOX, 10=NEWT_COLORSET_ACTCHECKBOX - my $subf = $scroll->Form('', 0); - $subf->FormSetHeight($height_avail); - $subf->FormAddGrid($grid, 0); - Newt::Grid::HCloseStacked3($subf, separator(1, $height_avail-1), $scroll); - } else { - $grid; - } - }; - - my ($ok, $cancel) = ($common->{ok}, $common->{cancel}); - my ($need_to_die); - if (!defined $cancel && !defined $ok) { - $cancel = $::isWizard && !$::Wizard_no_previous ? N("Previous") : N("Cancel"); - $need_to_die = 1 if !($::isWizard && !$::Wizard_no_previous); - } - $ok ||= $::isWizard ? ($::Wizard_finished ? N("Finish") : N("Next")) : N("Ok"); - - my @okcancel = grep { $_ } $ok, $cancel; - @okcancel = reverse(@okcancel) if $::isWizard; - my @buttons_text = (if_(@$l2, $common->{advanced_state} ? $common->{advanced_label_close} : $common->{advanced_label}), @okcancel); - my ($buttonbar, @buttons) = Newt::Grid::ButtonBar(map { simplify_string($_) } @buttons_text); - my $advanced_button = @$l2 && shift @buttons; - @buttons = reverse(@buttons) if $::isWizard; - my ($ok_button, $cancel_button) = @buttons; - - my $form = Newt::Component::Form(\undef, '', 0); - my $window = Newt::Grid::GridBasicWindow(first(myTextbox(!$has_scroll, $height - $total_size, @messages)), $listg, $buttonbar); - $window->GridWrappedWindow($common->{title} || ''); - $form->FormAddGrid($window, 1); - - my $check = sub { - my ($f) = @_; - - my ($error, $_focus) = $f->(); - - if ($error) { - $set_all->(); - } - !$error; - }; - - my ($blocked, $canceled); - while (1) { - my $r = $form->RunForm; - - $get_all->(); - - if ($advanced_button && $$r == $$advanced_button) { - invbool(\$common->{advanced_state}); - $form->FormDestroy; - Newt::PopWindow(); - return &ask_fromW_real; - } - - $canceled = $cancel_button && $$r == $$cancel_button; - - next if !$canceled && any { ${$_->{invalid_choice}} } @widgets; - - $blocked = - $$r == $$ok_button && - $common->{callbacks}{ok_disabled} && - do { $common->{callbacks}{ok_disabled}() }; - - if (my $button = find { $$r == ${$_->{w}} } @widgets) { - my $v = $button->{e}{clicked_may_quit}(); - $form->FormDestroy; - Newt::PopWindow(); - return $v || &ask_fromW; - } - last if !$blocked && $check->($common->{callbacks}{$canceled ? 'canceled' : 'complete'}); - } - - $form->FormDestroy; - Newt::PopWindow(); - die 'wizcancel' if $need_to_die && $canceled; - !$canceled; -} - - -sub waitbox { - my ($title, $messages) = @_; - my ($t, $w, $h) = myTextbox(1, $height, @$messages); - my $f = Newt::Component::Form(\undef, '', 0); - Newt::CenteredWindow($w, $h, $title); - $f->FormAddComponent($t); - $f->DrawForm; - Newt::Refresh(); - $f->FormDestroy; - push @wait_messages, $f; - $f; -} - - -sub wait_messageW { - my ($_o, $title, $messages) = @_; - { form => waitbox($title, $messages), title => $title }; -} - -sub wait_message_nextW { - my ($o, $messages, $w) = @_; - $o->wait_message_endW($w); - $o->wait_messageW($w->{title}, $messages); -} -sub wait_message_endW { - my ($_o, $_w) = @_; - my $_wait = pop @wait_messages; -# log::l("interactive_newt does not handle none stacked wait-messages") if $w->{form} != $wait; - Newt::PopWindow(); -} - -sub simplify_string { - my ($s, $o_width) = @_; - $s =~ s/\n/ /g; - $s = substr($s, 0, $o_width || 40); #- truncate if too long - $s; -} - -1; diff --git a/perl-install/interactive/stdio.pm b/perl-install/interactive/stdio.pm index 04b5abfcf..9dca9eaba 100644 --- a/perl-install/interactive/stdio.pm +++ b/perl-install/interactive/stdio.pm @@ -70,7 +70,7 @@ ask_fromW_begin: print N("Your choice? (0/1, default `%s') ", ${$e->{val}} || '0'); my $i = readln(); if ($i) { - to_bool($i) != to_bool(${$e->{val}}) and $common->{callbacks}{changed}->($ind); + to_bool($i) != to_bool(${$e->{val}}) and $common->{changed}->($ind); ${$e->{val}} = $i; } } elsif ($e->{type} =~ /list/) { @@ -89,12 +89,12 @@ ask_fromW_begin: print "\n"; my $i = good_choice(may_apply($e->{format}, ${$e->{val}}), $n); print "Setting to <", $i ? ${$e->{list}}[$i-1] : ${$e->{val}}, ">\n"; - $i and ${$e->{val}} = ${$e->{list}}[$i-1], $common->{callbacks}{changed}->($ind); + $i and ${$e->{val}} = ${$e->{list}}[$i-1], $common->{changed}->($ind); } elsif ($e->{type} eq 'button') { print N("Button `%s': %s", $e->{label}, may_apply($e->{format}, ${$e->{val}})), " $e->{text}\n"; print N("Do you want to click on this button?"); my $i = readln(); - $i && $i !~ /^n/i and $e->{clicked_may_quit}(), $common->{callbacks}{changed}->($ind); + $i && $i !~ /^n/i and $e->{clicked_may_quit}(), $common->{changed}->($ind); } elsif ($e->{type} eq 'label') { my $t = $format_label->($e); push @labels, $t; @@ -106,7 +106,7 @@ ask_fromW_begin: ${$e->{val}} = $i || ${$e->{val}}; ${$e->{val}} = '' if ${$e->{val}} eq 'void'; print "Setting to <", ${$e->{val}}, ">\n"; - $i and $common->{callbacks}{changed}->($ind); + $i and $common->{changed}->($ind); } else { printf "UNSUPPORTED WIDGET TYPE (type <%s> label <%s> text <%s> val <%s>\n", $e->{type}, $e->{label}, $e->{text}, ${$e->{val}}; } @@ -153,17 +153,18 @@ Your choice? "); } else { $i = 1; } - my ($callback_error) = $common->{callbacks}{$i == 2 ? 'canceled' : 'complete'}->(); - $callback_error and goto ask_fromW_begin; + if ($i == 1 && !$common->{validate}()) { + goto ask_fromW_begin; + } return $i != 2; } sub wait_messageW { - my ($_o, $_title, $message) = @_; - print join "\n", @$message; + my ($_o, $_title, $message, $message_modifiable) = @_; + print join "\n", $message, $message_modifiable; } sub wait_message_nextW { - my $m = join "\n", @{$_[1]}; + my $m = join "\n", $_[1]; print "\r$m", ' ' x (60 - length $m); } sub wait_message_endW { print "\nDone\n" } |