*** empty log message ***

6 files changed, 140 insertions, 19 deletions

diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index ed51b61a9..b7df29278 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,8 @@
+2000-04-10  François Pons  <fpons@mandrakesoft.com>
+
+	* interactive_gtk.pm, my_gtk.pm: added tooltips for ask_from_list,
+	which is used by printerdrake only. drops key bindings.
+
 2000-04-07  François Pons  <fpons@mandrakesoft.com>
 
 	* tools/serial_probe: obsoleting pnp_serial which is now replaced
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 5d4254cc1..55abb5b23 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -113,6 +113,35 @@ sub ask_from_list2($$$$;$) {
     $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;
+}
+
+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);
+}
+
+sub ask_from_list2_with_help($$$$$;$) {
+    my ($o, $title, $message, $l, $help, $def) = @_;
+
+    @$l > 10 and $l = [ sort @$l ];
+
+    $o->ask_from_list_with_helpW($title, [ deref($message) ], $l, $help, $def || $l->[0]);
+}
+
 sub ask_from_treelist {
     my ($o, $title, $message, $separator, $l, $def) = @_;
     $o->ask_from_treelistW($title, [ deref($message) ], $separator, [ sort @$l ], $def || $l->[0]);
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 7cfc44f57..5e4764f7b 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -30,18 +30,25 @@ sub exit {
 
 sub ask_from_listW {
     my ($o, $title, $messages, $l, $def) = @_;
+    ask_from_list_with_helpW($o, $title, $messages, $l, undef, $def);
+}
+
+sub ask_from_list_with_helpW {
+    my ($o, $title, $messages, $l, $help, $def) = @_;
     my $r;
 
     my $w = my_gtk->new(first(deref($title)), %$o);
     $w->{retval} = $def || $l->[0]; #- nearly especially for the X test case (see timeout in Xconfigurator.pm)
     if (@$l < 5) {
 	my $defW;
+	my $tips = new Gtk::Tooltips;
 	my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
 	gtkadd($w->{window},
 	       gtkpack(create_box_with_title($w, @$messages),
 		       gtkadd(@$l < 3 && sum(map { length $_ } @$l) < 60 ? create_hbox() : create_vbox(),
 			      map {
 				  my $b = new Gtk::Button($_);
+				  $tips->set_tip($b, $help->{$_}) if $help && $help->{$_};
 				  $b->signal_connect(clicked => [ $f, $_ ]);
 				  $_ eq $def and $defW = $b;
 				  $b;
@@ -52,7 +59,10 @@ sub ask_from_listW {
 	$w->{rwindow}->set_position('center') if $::isStandalone;
 	$r = $w->main;
     } else {
-	$w->_ask_from_list($title, $messages, $l, $def);
+	#- use ask_from_list_with_help only when needed, as key bindings are
+	#- dropped by List (CList does not seems to accepts Tooltips).
+	$help ? $w->_ask_from_list_with_help($title, $messages, $l, $help, $def) :
+	  $w->_ask_from_list($title, $messages, $l, $def);
 	$r = $w->main;
     }
     $r or die "ask_from_list cancel";
@@ -139,11 +149,11 @@ sub ask_from_treelistW {
 
 sub ask_many_from_list_refW {
     my ($o, $title, $messages, $list, $val) = @_;
-    ask_many_from_list_with_help_refW($o, $title, $messages, $list, undef, $val)
+    ask_many_from_list_with_help_refW($o, $title, $messages, undef, $list, $val)
 }
 
 sub ask_many_from_list_with_help_refW {
-    my ($o, $title, $messages, $list, $help, $val) = @_;
+    my ($o, $title, $messages, $help, $list, $val) = @_;
     my $w = my_gtk->new('', %$o);
     my $tips = new Gtk::Tooltips;
     my $box = gtkpack(new Gtk::VBox(0,0),
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index be64d842b..c1f35749e 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -531,6 +531,81 @@ sub _ask_from_list {
 
     $list->grab_focus;
 }
+sub _ask_from_list_with_help {
+    my ($o, $title, $messages, $l, $help, $def) = @_;
+    my (undef, @okcancel) = ref $title ? @$title : $title;
+    my $list = new Gtk::List();
+    my ($first_time, $starting_word, $start_reg) = (1, '', "^");
+    my (@widgets, $timeout, $curr);
+
+    my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit };
+    my $select = sub {
+	$list->select_item($_[1]);
+    };
+
+    ref $title && !@okcancel ?
+      $list->signal_connect(button_release_event => $leave) :
+      $list->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ });
+
+    $list->signal_connect(select_child => sub {
+	my ($w, $row) = @_;
+	$curr = $list->child_position($row);
+    });
+    $list->signal_connect(key_press_event => sub {
+        my ($w, $e) = @_;
+	my $c = chr $e->{keyval};
+
+	Gtk->timeout_remove($timeout) if $timeout; $timeout = '';
+
+	if ($e->{keyval} >= 0x100) {
+	    &$leave if $c eq "\r" || $c eq "\x8d";
+	    $starting_word = '' if $e->{keyval} != 0xffe4; # control
+	} else {
+	    if ($e->{state} & 4) {
+		#- control pressed
+		$c eq "s" or return 1;
+		$start_reg and $start_reg = '', return 1;
+		$curr++;
+	    } else {
+		&$leave if $c eq ' ';
+
+		$curr++ if $starting_word eq '' || $starting_word eq $c;
+		$starting_word .= $c unless $starting_word eq $c;
+	    }
+	    my $word = quotemeta $starting_word;
+	    my $j; for ($j = 0; $j < @$l; $j++) {
+		 $l->[($j + $curr) % @$l] =~ /$start_reg$word/i and last;
+	    }
+	    $j == @$l ?
+	      $starting_word = '' :
+	      &$select(($j + $curr) % @$l);
+
+	    $w->{timeout} = $timeout = Gtk->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 } );
+	}
+	1;
+    });
+
+    $o->{ok_clicked} = $leave;
+    $o->{cancel_clicked} = sub { $o->destroy; die "ask_from_list cancel" }; #- make sure windows doesn't live any more.
+    gtkadd($o->{window},
+	   gtkpack($o->create_box_with_title(@$messages),
+		   gtkpack_(new Gtk::VBox(0,7),
+			    1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, min(350, $::windowheight - 60)) : $list,
+			    @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ())
+		  ));
+    $o->show; #- otherwise the moveto is not done
+    my $tips = new Gtk::Tooltips;
+    my $toselect; map_index {
+	my $item = new Gtk::ListItem($_);
+	$list->append_items($item);
+	$tips->set_tip($item, $help->{$_}) if $help->{$_};
+	$item->show;
+	$toselect = $::i if $def && $_ eq $def;
+    } @$l;
+    &$select($toselect);
+
+    $list->grab_focus;
+}
 
 sub _ask_warn($@) {
     my ($o, @msgs) = @_;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index f7e847b9f..66db36844 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -28,7 +28,7 @@ use strict;
 =cut
 
 #-#####################################################################################
-use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv $printer_type_default @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_db %db_to_descr);
+use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv $printer_type_default @papersize_type %fields $spooldir @entries_db_short @entry_db_description %descr_to_help %descr_to_db %db_to_descr);
 #-#####################################################################################
 
 =head2 Imports
@@ -355,16 +355,16 @@ sub read_printer_db(;$) {
 		SWITCH: {
 		      /GSDriver:\s*(\w*)/      and do { $entry->{GSDRIVER} = $1; last SWITCH };
 		      /Description:\s*{(.*)}/  and do { $entry->{DESCR}    = $1; last SWITCH };
-		      /About:\s*{(.*)}/        and do { $entry->{ABOUT}    = $1; last SWITCH };
-		      /About:\s*{(.*)/
-			and do
-			  {
-			      my $string = "$1\n";
-			      while (<DBPATH>) {
-				  /(.*)}/ and do { $entry->{ABOUT} = $string; last SWITCH };
-				  $string .= $_;
-			      }
-			  };
+		      /About:\s*{\s*(.*?)\s*}/ and do { $entry->{ABOUT}    = $1; last SWITCH };
+		      /About:\s*{\s*(.*?)\s*\\\s*$/
+			and do {
+			    my $string = $1;
+			    while (<DBPATH>) {
+				$string =~ /\S$/ and $string .= ' ';
+				/^\s*(.*?)\s*\\\s*$/ and $string .= $1;
+				/^\s*(.*?)\s*}\s*$/  and do { $entry->{ABOUT} = $string . $1; last SWITCH };
+			    }
+			};
 		      /Resolution:\s*{(.*)}\s*{(.*)}\s*{(.*)}/
 			and do { push @{$entry->{RESOLUTION} ||= []}, { XDPI => $1, YDPI => $2, DESCR => $3 }; last SWITCH };
 		      /BitsPerPixel:\s*{(.*)}\s*{(.*)}/
@@ -382,6 +382,7 @@ sub read_printer_db(;$) {
 
     @entries_db_short     = sort keys %printer::thedb;
     %descr_to_db          = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
+    %descr_to_help        = map { $printer::thedb{$_}{DESCR}, $printer::thedb{$_}{ABOUT} } @entries_db_short;
     @entry_db_description = keys %descr_to_db;
     %db_to_descr          = reverse %descr_to_db;
 }
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
index 8901e1f0d..fd6787591 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printerdrake.pm
@@ -121,11 +121,12 @@ sub setup_gsdriver($$) {
     do {
 	$printer->{DBENTRY} ||= $printer::thedb_gsdriver{$printer->{GSDRIVER}}{ENTRY};
 	eval { $printer->{DBENTRY} = $printer::descr_to_db{
-				$in->ask_from_list_(_("Configure Printer"),
-						    _("What type of printer do you have?"),
-						    [@printer::entry_db_description],
-						    $printer::db_to_descr{$printer->{DBENTRY}},
-						   )
+	    $in->ask_from_list_with_help_(_("Configure Printer"),
+					  _("What type of printer do you have?"),
+					  [ @printer::entry_db_description ],
+					  { %printer::descr_to_help },
+					  $printer::db_to_descr{$printer->{DBENTRY}},
+					 )
 			       };
 	}; $@ =~ /^ask_from_list cancel/ and return;