summaryrefslogtreecommitdiffstats
path: root/perl-install/interactive
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/interactive')
-rw-r--r--perl-install/interactive/curses.pm591
-rw-r--r--perl-install/interactive/gtk.pm830
-rw-r--r--perl-install/interactive/http.pm8
-rw-r--r--perl-install/interactive/newt.pm423
-rw-r--r--perl-install/interactive/stdio.pm19
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" }
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-11 01:43:00 +0000