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

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) ]);