From 2d92149a58246b77fc9427fbdd354baba4982a86 Mon Sep 17 00:00:00 2001
From: Pascal Rigaux <pixel@mandriva.com>
Date: Tue, 12 Sep 2000 23:40:48 +0000
Subject: no_comment

---
 perl-install/install_gtk.pm | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

(limited to 'perl-install/install_gtk.pm')

diff --git a/perl-install/install_gtk.pm b/perl-install/install_gtk.pm
index 7f1717f54..40daf8447 100644
--- a/perl-install/install_gtk.pm
+++ b/perl-install/install_gtk.pm
@@ -367,13 +367,14 @@ END
 sub test_mouse {
     my ($mouse) = @_;
 
-    my $w = my_gtk->new('');
+    my $w = my_gtk->new;
     my ($width, $height, $offset) = (210, 300, 25);
-    my ($bw, $bh) = ($width / 3, $height * 2 / 5);
+    my ($bw, $bh) = ($width / 3, $height / 3);
 
     gtkadd($w->{window}, 
 	   gtkpack(new Gtk::VBox(0,0),
 		   my $darea = gtkset_usize(new Gtk::DrawingArea, $width+1, $height+1),
+		   '',
 		   create_okcancel($w, '', '', "edge"),
 		  ),
 	  );
@@ -408,8 +409,11 @@ sub test_mouse {
 	my $w = $font->string_width($t);
 	$darea->window->draw_string($font, $darea->style->fg_gc('normal'), ($width - $w) / 2, $y, $t);
     };
+    my $default_time = 10;
+    my $time = $default_time;
     $darea->signal_connect(button_press_event => sub {
 			       my $b = $_[1]{button};
+			       $time = $default_time;
 			       $b >= 4 ?
 				 $paintWheel->($b == 4 ? -1 : 1) :
 				 $paintButton->($b - 1, 1);
@@ -422,10 +426,13 @@ sub test_mouse {
     $darea->set_events([ 'button_press_mask', 'button_release_mask' ]);
 
     $w->sync; # HACK
-    $draw_rect->(0, 1, [ 0, 0, $width, $height]);
+    $draw_rect->(1, 0, [ 0, 0, $width, $height]);
     $draw_text->(_("Please test the mouse"), 2 * $bh - 20);
-    $draw_text->(_("Move your wheel"), 2 * $bh) if $mouse->{XMOUSETYPE} eq 'IMPS/2';
+    $draw_text->(_("Move your wheel!"), 2 * $bh + 10) if $mouse->{XMOUSETYPE} eq 'IMPS/2';
     $paintButton->($_, 0) foreach 0..2;
+    $w->{cancel}->grab_focus;
+    my $timeout = Gtk->timeout_add(1000, sub { if ($time-- == 0) { undef $w->{retval}; Gtk->main_quit } 1 });
+    my $b = before_leaving { Gtk->timeout_remove($timeout) };
     $w->main;
 }
 
-- 
cgit v1.2.1