summaryrefslogtreecommitdiffstats
path: root/perl-install/interactive.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2001-01-05 17:12:51 +0000
committerPascal Rigaux <pixel@mandriva.com>2001-01-05 17:12:51 +0000
commit937943b4502499a9afae32313f47a73352a21a41 (patch)
tree4a9570acd26db16e0acd5094970321e489ab7d2c /perl-install/interactive.pm
parent85e3ac6e225bd09cfa913a3a3812335f99cbfd3c (diff)
downloaddrakx-937943b4502499a9afae32313f47a73352a21a41.tar
drakx-937943b4502499a9afae32313f47a73352a21a41.tar.gz
drakx-937943b4502499a9afae32313f47a73352a21a41.tar.bz2
drakx-937943b4502499a9afae32313f47a73352a21a41.tar.xz
drakx-937943b4502499a9afae32313f47a73352a21a41.zip
move to new ask_from's:
- ask_from_entries_ref is deprecated, use ask_from_entries_refH - ask_from_list now calls ask_from_entries_refH_powered still not done: - ask_from_treelist should use ask_from_entries_refH_powered, and lists with no help should use CList (List is bad) - keyboard and mouse binding is still rough - enhance the look
Diffstat (limited to 'perl-install/interactive.pm')
-rw-r--r--perl-install/interactive.pm199
1 files changed, 84 insertions, 115 deletions
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 1de89e42a..773bce0fa 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -8,10 +8,21 @@ use strict;
#-######################################################################################
use common qw(:common :functional);
+#- ask_from_entries takes:
+#- val => reference to the value
+#- label => description
+#- icon => icon to put before the description
+#- help => tooltip
+#- advanced => wether it is shown in by default or only in advanced mode
+#- type =>
+#- bool (with text)
+#- range (with min, max)
+#- combo (with list, not_edit)
+#- list (with list, icon2f (aka icon), separator (aka tree), help can be a hash or a function)
+
#- heritate from this class and you'll get all made interactivity for same steps.
#- for this you need to provide
#- - ask_from_listW(o, title, messages, arrayref, default) returns one string of arrayref
-#- - ask_many_from_listW(o, title, messages, arrayref, arrayref2) returns many strings of arrayref
#-
#- where
#- - o is the object
@@ -26,7 +37,7 @@ use common qw(:common :functional);
#- ask_from_list_ just translate arrayref before calling ask_from_list and untranslate the result
#-
#- ask_from_listW should handle differently small lists and big ones.
-
+#-
#-######################################################################################
@@ -71,32 +82,32 @@ sub exit { exit($_[0]) }
#-######################################################################################
#- Interactive functions
#-######################################################################################
-sub ask_warn($$$) {
+sub ask_warn {
my ($o, $title, $message) = @_;
- ask_from_list2($o, $title, $message, [ _("Ok") ]);
+ ask_from_list_no_check($o, $title, $message, [ _("Ok") ]);
}
-sub ask_yesorno($$$;$) {
- my ($o, $title, $message, $def) = @_;
- ask_from_list_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "Yes" : "No") eq "Yes";
+sub ask_yesorno {
+ my ($o, $title, $message, $def, $help) = @_;
+ ask_from_list_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "Yes" : "No", $help) eq "Yes";
}
-sub ask_okcancel($$$;$) {
- my ($o, $title, $message, $def) = @_;
- ask_from_list_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Ok" : "Cancel") eq "Ok";
+sub ask_okcancel {
+ my ($o, $title, $message, $def, $help) = @_;
+ ask_from_list_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Ok" : "Cancel", $help) eq "Ok";
}
sub ask_from_list_ {
- my ($o, $title, $message, $l, $def) = @_;
- ask_from_listf($o, $title, $message, sub { translate($_[0]) }, $l, $def);
+ my ($o, $title, $message, $l, $def, $help) = @_;
+ ask_from_listf($o, $title, $message, sub { translate($_[0]) }, $l, $def, $help);
}
sub ask_from_listf_ {
- my ($o, $title, $message, $f, $l, $def) = @_;
- ask_from_listf($o, $title, $message, sub { translate($f->(@_)) }, $l, $def);
+ my ($o, $title, $message, $f, $l, $def, $help) = @_;
+ ask_from_listf($o, $title, $message, sub { translate($f->(@_)) }, $l, $def, $help);
}
sub ask_from_listf {
- my ($o, $title, $message, $f, $l, $def) = @_;
+ my ($o, $title, $message, $f, $l, $def, $help) = @_;
my $def2;
my (@l,%l); my $i = 0; foreach (@$l) {
my $v = $f->($_, $i++);
@@ -105,58 +116,28 @@ sub ask_from_listf {
$def2 = $v if $def && $_ eq $def;
}
$def2 ||= $f->($def) if $def;
- my $r = ask_from_list($o, $title, $message, \@l, $def2) or return;
+ my $r = ask_from_list($o, $title, $message, \@l, $def2, $help) or return;
$l{$r};
}
sub ask_from_list {
- my ($o, $title, $message, $l, $def) = @_;
+ my ($o, $title, $message, $l, $def, $help) = @_;
@$l == 0 and die 'ask_from_list: empty list';
@$l == 1 and return $l->[0];
- goto &ask_from_list2;
-}
-
-sub ask_from_list2($$$$;$) {
- my ($o, $title, $message, $l, $def) = @_;
-
- @$l > 10 and $l = [ sort @$l ];
-
- $o->ask_from_listW($title, [ deref($message) ], $l, $def || $l->[0]);
-}
-
-sub ask_from_list_with_help_ {
- my ($o, $title, $message, $l, $help, $def) = @_;
- @$l == 0 and die '';
- @$l == 1 and return $l->[0];
- goto &ask_from_list2_with_help_;
-}
-
-sub ask_from_list_with_help {
- my ($o, $title, $message, $l, $help, $def) = @_;
- @$l == 0 and die '';
- @$l == 1 and return $l->[0];
- goto &ask_from_list2_with_help;
-}
-
-#- defaults to simple ask_from_list
-sub ask_from_list_with_helpW {
- my ($o, $title, $messages, $l, $help, $def) = @_;
- $o->ask_from_listW($o, $title, $messages, $l, $def);
-}
-
-sub ask_from_list2_with_help_($$$$$;$) {
- my ($o, $title, $message, $l, $help, $def) = @_;
- untranslate(
- ask_from_list_with_help($o, $title, $message, [ map { translate($_) } @$l ], $help, translate($def)),
- @$l);
+ goto &ask_from_list_no_check;
}
-sub ask_from_list2_with_help($$$$$;$) {
- my ($o, $title, $message, $l, $help, $def) = @_;
+sub ask_from_list_no_check {
+ my ($o, $title, $message, $l, $def, $help) = @_;
- @$l > 10 and $l = [ sort @$l ];
-
- $o->ask_from_list_with_helpW($title, [ deref($message) ], $l, $help, $def || $l->[0]);
+ if (@$l <= 2) {
+ ask_from_entries_refH_powered($o, { title => $title, messages => [ deref($message) ], ok => $l->[0], cancel => $l->[1] }, [])
+ ? $l->[0] : $l->[1];
+ } else {
+ @$l > 10 and $l = [ sort @$l ];
+ ask_from_entries_refH($o, $title, $message, [ { val => \$def, type => 'list', list => $l, help => $help } ]);
+ $def;
+ }
}
sub ask_from_treelistf {
@@ -175,7 +156,7 @@ sub ask_from_treelist {
$o->ask_from_treelistW($title, [ deref($message) ], $separator, [ sort @$l ], $def || $l->[0]);
}
#- defaults to simple ask_from_list
-sub ask_from_treelistW($$$$;$) {
+sub ask_from_treelistW {
my ($o, $title, $message, $separator, $l, $def) = @_;
$o->ask_from_listW($title, [ deref($message) ], $l, $def);
}
@@ -185,89 +166,77 @@ sub ask_many_from_list {
my ($o, $title, $message, @l) = @_;
@l = grep { @{$_->{list}} } @l or return '';
foreach my $h (@l) {
- $h->{labels} ||= [ map { $h->{label} ? $h->{label}->($_) : $_ } @{$h->{list}} ];
-
- if ($h->{sort}) {
- my @places = sort { $h->{labels}[$a] cmp $h->{labels}[$b] } 0 .. $#{$h->{labels}};
- $h->{labels} = [ map { $h->{labels}[$_] } @places ];
- $h->{list} = [ map { $h->{list}[$_] } @places ];
- }
- $h->{ref} = [ map {
- $h->{ref} ? $h->{ref}->($_) : do {
- my $i =
+ $h->{e}{$_} = {
+ text => $h->{label} ? $h->{label}->($_) : $_,
+ val => $h->{val} ? $h->{val}->($_) : do {
+ my $i =
$h->{value} ? $h->{value}->($_) :
$h->{values} ? member($_, @{$h->{values}}) : 0;
\$i;
- };
- } @{$h->{list}} ];
-
- $h->{help} = $h->{help} ? [ map { $h->{help}->($_) } @{$h->{list}} ] : [];
- $h->{icons} = $h->{icon2f} ? [ map { $h->{icon2f}->($_) } @{$h->{list}} ] : [];
+ },
+ type => 'bool',
+ help => $h->{help} ? $h->{help}->($_) : '',
+ icon => $h->{icon2f} ? $h->{icon2f}->($_) : '',
+ } foreach @{$h->{list}};
+ if ($h->{sort}) {
+ $h->{list} = [ sort { $h->{e}{$a}{label} cmp $h->{e}{$b}{label} } @{$h->{list}} ];
+ }
}
- $o->ask_many_from_listW($title, [ deref($message) ], @l) or return;
+ $o->ask_from_entries_refH($title, $message, [ map { my $h = $_; map { $h->{e}{$_} } @{$h->{list}} } @l ]) or return;
@l = map {
my $h = $_;
- [ grep_index { ${$h->{ref}[$::i]} } @{$h->{list}} ];
+ [ grep { ${$h->{e}{$_}{val}} } @{$h->{list}} ];
} @l;
wantarray ? @l : $l[0];
}
sub ask_from_entry {
- my ($o, $title, $message, $label, $def, %callback) = @_;
-
- first ($o->ask_from_entries($title, [ deref($message) ], [ $label ], [ $def ], %callback));
+ my ($o, $title, $message, %callback) = @_;
+ first(ask_from_entries($o, $title, $message, [''], %callback));
}
+sub ask_from_entries {
+ my ($o, $title, $message, $l, %callback) = @_;
-sub ask_from_entries($$$$;$%) {
- my ($o, $title, $message, $l, $def, %callback) = @_;
-
- my $val = [ map { my $i = $_; \$i } @{$def || [('') x @$l]} ];
+ my @l = map { my $i = ''; { label => $_, val => \$i } } @$l;
- $o->ask_from_entries_ref($title, $message, $l, $val, %callback) ?
- map { $$_ } @$val :
+ $o->ask_from_entries_refH($title, $message, \@l, %callback) ?
+ map { ${$_->{val}} } @l :
undef;
}
-sub ask_from_entries_refH($$$;$%) {
- my ($o, $title, $message, $h, %callback) = @_;
-
- ask_from_entries_ref($o, $title, $message,
- list2kv(@$h),
- %callback);
-}
-
#- can get a hash of callback: focus_out changed and complete
#- moreove if you pass a hash with a field list -> combo
#- if you pass a hash with a field hidden -> emulate stty -echo
-sub ask_from_entries_ref($$$$;$%) {
- my ($o, $title, $message, $l, $val, %callback) = @_;
+sub ask_from_entries_refH {
+ my ($o, $title, $message, $l, %callback) = @_;
return unless @$l;
+ ask_from_entries_refH_powered($o, { title => $title, messages => [ deref($message) ], callbacks => \%callback }, $l);
+}
- $title = [ deref($title) ];
- $title->[2] ||= _("Cancel") unless $title->[1];
- $title->[1] ||= _("Ok");
-
- my $val_hash = [ map {
- if ((ref $_) eq "SCALAR") {
- { val => $_ }
- } else {
- if (@{$_->{list} || []} > 1) {
- add2hash_($_, { not_edit => 1, type => 'list' });
- ${$_->{val}} = $_->{list}[0] if $_->{not_edit} && !member(${$_->{val}}, @{$_->{list}});
- } elsif ($_->{type} eq 'range') {
- $_->{min} <= $_->{max} or die "bad range min $_->{min} > max $_->{max} (called from " . join(':', caller()) . ")";
- ${$_->{val}} = max($_->{min}, min(${$_->{val}}, $_->{max}));
- }
- $_;
+sub ask_from_entries_refH_powered {
+ my ($o, $common, $l) = @_;
+
+ #- normalize
+ foreach (@$l) {
+ if (@{$_->{list} || []} > 1) {
+ $_->{type} = 'iconlist' if $_->{icon2f};
+ $_->{type} = 'treelist' if $_->{separator};
+ add2hash_($_, { not_edit => 1, type => 'combo' });
+ ${$_->{val}} = $_->{list}[0] if ($_->{type} ne 'combo' || $_->{not_edit}) && !member(${$_->{val}}, @{$_->{list}});
+ } elsif ($_->{type} eq 'range') {
+ $_->{min} <= $_->{max} or die "bad range min $_->{min} > max $_->{max} (called from " . join(':', caller()) . ")";
+ ${$_->{val}} = max($_->{min}, min(${$_->{val}}, $_->{max}));
}
- } @$val ];
-
- $o->ask_from_entries_refW($title, [ deref($message) ], $l, $val_hash, %callback)
+ }
+ add2hash_($common->{callbacks} ||= {}, { changed => sub {}, focus_out => sub {}, complete => sub { 0 } });
+ $o->ask_from_entries_refW($common,
+ [ grep { !$_->{advanced} } @$l ],
+ [ grep { $_->{advanced} } @$l ])
}
-sub wait_message($$$;$) {
+sub wait_message {
my ($o, $title, $message, $temp) = @_;
my $w = $o->wait_messageW($title, [ _("Please wait"), deref($message) ]);