Adaptation du widget LabFrame pour y associer un bouton de commande servant

à agrandir la frame.
Nouvelle gestion de la barre de progression.

1 files changed, 183 insertions, 56 deletions

diff --git a/src/ivymon b/src/ivymon
index 79c7de9..618ccfe 100755
--- a/src/ivymon
+++ b/src/ivymon
@@ -1,12 +1,81 @@
 #!/usr/bin/perl
 
+#=================================================================================
+#
+# Tk::LabFrame Extension
+#
+#=================================================================================
+# derived from Tk::LabFrame v3.021
+# 
+package Tk::eLabFrame;
+
+
+use Tk;
+require Tk::Frame;
 
+use strict;
+use base qw(Tk::Frame);
+Construct Tk::Widget 'eLabFrame';
+
+
+sub Populate {
+    my ($cw, $args) = @_;
+    my $f;
+    my $label;
+    my $button;
+    my $lside = exists $args->{-labelside} ?
+	delete $args->{-labelside} : 'top';
+    my $ltext = delete $args->{-label};
+    my $lbutton = delete $args->{-buttonbmp};
+    $cw->SUPER::Populate($args);
+    if ($lside =~ /acrosstop/) {
+	my $border = $cw->Frame(-relief => 'groove', -bd => 2);
+        $cw->Advertise('border' => $border);
+	my $pad = $border->Frame;
+	$f = $border->Frame;
+	$label = $cw->Label(-text => $ltext);
+	$button = $cw->Button(-image => $lbutton) if defined $lbutton;
+	my $y = int($label->winfo('reqheight')) / 2;
+	my $ph = $y - int($border->cget(-bd));
+	if ($ph < 0) {
+	    $ph = 0;
+	}
+	$label->form(-top => 0, -left => 4, -padx => 6, -pady => 2);
+	$button->form(-top => 0, -right => -4, -padx => 6, -pady => 0) if defined $button;
+        # $label->place('-y' => 2, '-x' => 10);
+	$border->form(-top => $y, -bottom => -1, -left => 0, -right => -1,
+		      -padx => 2, -pady => 2);
+	$pad->form(-left => 0, -right => -1, -top => 0, -bottom => $ph);
+	$f->form(-top => $pad, -bottom => -1, -left => 0, -right => -1);
+	# $cw->Delegates('pack' => $cw);
+    } else {
+	$f = $cw->Frame(-relief => 'groove', -bd => 2, %{$args});
+	$label = $cw->Label(-text => $ltext);
+	$label->pack(-side => $lside);
+	$f->pack(-side => $lside, -fill => 'both', -expand => 1);
+    }
+    $cw->Advertise('frame' => $f);
+    $cw->Advertise('label' => $label);
+    $cw->Advertise('button' => $button) if defined $button;
+    $cw->Delegates(DEFAULT => $f);
+    $cw->ConfigSpecs(-labelside => ['PASSIVE', 'labelSide', 'LabelSide', 'acrosstop'],
+		     'DEFAULT' => [$f]);
+}
+
+
+#=================================================================================
+#
+# M A I N
+#
+#=================================================================================
+
+package main;
 
 $SIG{INT} = \&quit;
 $SIG{QUIT} = \&quit;
 use Tk;
-use Tk::Font;
 use Tk::LabFrame;
+use Tk::Font;
 use Tk::Balloon;
 use Tk::FBox;
 use Tk::ErrorDialog;
@@ -125,6 +194,8 @@ my $replay_fg = 'black';
 my $replay_bg_orig;
 my $replay_fg_orig;
 my $replay_hour;
+
+
 #----------------------------------------------------------------------------------
 # command line options management
 #----------------------------------------------------------------------------------
@@ -258,9 +329,35 @@ if($opt_undersize)
 my $mw = MainWindow->new();
 
 # Set default min size
+$mw->geometry($minW."x".$minH);
 $mw->minsize($minW, $minH);
 $mw->title($title);
 
+# bitmaps
+my $enlargebmp = $mw->Bitmap(-data => <<EOF);
+#define expand_width 24
+#define expand_height 16
+static unsigned char expand_bits[] = {
+  0x03, 0x42, 0xc0, 0x03, 0xc3, 0xc0, 0x83, 0xc3, 0xc1, 0xc3, 0xc3, 0xc3,
+  0xe3, 0xc3, 0xc7, 0xf3, 0xc3, 0xcf, 0xfb, 0xc3, 0xdf, 0xff, 0xc3, 0xff,
+  0xff, 0xc3, 0xff, 0xfb, 0xc3, 0xdf, 0xf3, 0xc3, 0xcf, 0xe3, 0xc3, 0xc7,
+  0xc3, 0xc3, 0xc3, 0x83, 0xc3, 0xc1, 0x03, 0xc3, 0xc0, 0x03, 0x42, 0xc0,
+  };
+
+EOF
+
+my $shrinkbmp = $mw->Bitmap(-data => <<EOF);
+#define shrink_width 24
+#define shrink_height 16
+static unsigned char shrink_bits[] = {
+  0x01, 0xc3, 0x80, 0x03, 0xc3, 0xc0, 0x07, 0xc3, 0xe0, 0x0f, 0xc3, 0xf0,
+  0x1f, 0xc3, 0xf8, 0x3f, 0xc3, 0xfc, 0x7f, 0xc3, 0xfe, 0xff, 0xc3, 0xff,
+  0xff, 0xc3, 0xff, 0x7f, 0xc3, 0xfe, 0x3f, 0xc3, 0xfc, 0x1f, 0xc3, 0xf8,
+  0x0f, 0xc3, 0xf0, 0x07, 0xc3, 0xe0, 0x03, 0xc3, 0xc0, 0x01, 0xc3, 0x80,
+  };
+
+EOF
+
 # Key-Tab binding is deactivated, because this event will be used by entries
 # for completion functionality
 $mw->bind('<Key-Tab>', sub {Tk->break});
@@ -303,32 +400,27 @@ my $clients_fm =
 						  -padx => 5*$coef,
 						  );
 my $send_fm =
-    $bottom_fm->LabFrame(-label => ' Messages to send : ',
-			 -labelside => 'acrosstop',
-			 -borderwidth => 3)->pack(-fill => 'x',
-						  -side => 'left',
-						  -expand => 1,
-						  -padx => 5*$coef,
-						  );
-my $send_lab = $send_fm->Subwidget('label');
-my $send_lab_bgcolor = $send_lab->cget(-background);
-
-$send_lab->configure(-relief => 'groove');
-$send_lab->bind("<Enter>", sub {
-    $send_lab->configure( -relief => 'raised');
-});
-$send_lab->bind("<Leave>", sub {
-    $send_lab->configure(-bg => $send_lab_bgcolor, -relief => 'groove');
-});
-$send_lab->bind("<1>", sub {
-    if ($enlarge) {
-	&shrink;
-	$enlarge = 0;
-    } else {
-	&enlarge;
-	$enlarge = 1;
-    }
-});
+    $bottom_fm->eLabFrame(-label => ' Messages to send : ',
+			  -buttonbmp => $enlargebmp, 
+			  -labelside => 'acrosstop',
+			  -borderwidth => 3)->pack(-fill => 'x',
+						   -side => 'left',
+						   -expand => 1,
+						   -padx => 5*$coef,
+						   );
+my $sendEnlargeBtn = $send_fm->Subwidget('button');
+$sendEnlargeBtn->configure(-relief => 'flat',
+			   -command => sub {
+			       if ($enlarge) {
+				   &shrink;
+				   $enlarge = 0;
+				   $sendEnlargeBtn->configure(-image => $enlargebmp);
+			       } else {
+				   &enlarge;
+				   $enlarge = 1;
+				   $sendEnlargeBtn->configure(-image => $shrinkbmp);
+			       }
+			   });
 
 my $searchandcontrol_fm = $bottom_fm->Frame()->pack(-fill => 'both',
 						    -side => 'right',
@@ -347,22 +439,28 @@ my $control_fm =
 							    -side => 'bottom',
 							    -padx => 5*$coef,
 							    -expand => 0);
-my $progressbar;
-=pod
-my $progressbar =
-    $bottom_fm->ProgressBar(-from => 0,
-			    -length => 200,
-			    -borderwidth => 2,
-			    -colors => [ 0 => 'yellow'],
-			    -relief => 'sunken',
-			    -resolution => 0,
-			    -anchor => 'n',
-			    )->pack(-fill => 'none',
-				    -side => 'right',
-				    -expand => 0,
-				    -padx => 5*$coef,
-				    );
-=cut
+
+#----------------------------------------------------------------------------------
+# Progress bar
+#----------------------------------------------------------------------------------
+my $tpl = $mw->Toplevel;
+$tpl->Popup;
+$tpl->raise($mw);
+$tpl->title("");
+$tpl->geometry("300x50");
+my $progressbar = $tpl->ProgressBar(-from => 0,
+				 -length => 200,
+				 -borderwidth => 2,
+				 -colors => [ 0 => 'yellow'],
+				 -relief => 'sunken',
+				 -resolution => 0,
+				 -anchor => 'w',
+				 )->pack(-fill => 'both',
+					 -expand => 1,
+					 );
+$progressbar->value(0);
+$tpl->withdraw;
+
 #----------------------------------------------------------------------------------
 # Messages display area
 #----------------------------------------------------------------------------------
@@ -821,7 +919,7 @@ $balloonhelp->attach($sendList, -balloonmsg =>
 		     );
 $balloonhelp->attach($messagesText, -balloonmsg =>
 		     "You can insert colored marker by double-clicking on a \n".
-		     "message application name (marker will be created after\n".
+		     "message application name (marker will be createafter\n".
 		     "the message). Then, you can quickly access markers    \n".
 		     "using the [Jump] button in control panel. To remove a \n".
 		     "marker, just double-click on it.                      "
@@ -854,7 +952,7 @@ $balloonhelp->attach($saveButton, -balloonmsg =>
 		     "Save the content of Messages\n".
 		     "area in a file.             "
 		     );
-$balloonhelp->attach($send_lab, -balloonmsg =>
+$balloonhelp->attach($sendEnlargeBtn, -balloonmsg =>
 		     "Click here to enlarge or shrink this frame"
 		     );
 
@@ -904,6 +1002,7 @@ if (@ARGV > 0) {
     if ( not open(IN, $file)) {
 	$mw->Tk::Error("Can't open file '$file' ($!)");
     } else {
+	&showProgressbar();
 	my ($step, $timefound) = &stepsnumber;
 	if ($opt_loadingmode eq 'replay-pause' or $opt_loadingmode eq 'replay') {
 	    if ($timefound) {
@@ -916,7 +1015,7 @@ if (@ARGV > 0) {
 	} elsif ($opt_loadingmode eq 'display') {
 	    &loadfileForDisplay($step);
 	}
-	$progressbar->value(0);
+	&hideProgressbar();
 	close(IN);
     }
 }
@@ -2007,6 +2106,7 @@ sub loadfile {
 	return;
     }
     my $loadingmode = 'display';
+    &showProgressbar();
     my ($step, $timefound) = &stepsnumber();
     if ($timefound) {
 	$loadingmode = &selectLoadingMode();
@@ -2018,7 +2118,7 @@ sub loadfile {
     } else {
 	&loadfileForDisplay($step);
     }
-    $progressbar->value(0);
+    &hideProgressbar();
     close(IN);
    
 } # end loadfile
@@ -2036,7 +2136,6 @@ sub stepsnumber {
 	chomp;
 	next if (/^applications=/ or /^(marker\d+)$/);
 	if (/^messages_number=(.*)/) {
-	    $progressbar->configure(-to => $1);
 	    $step = int($1/10);
 	    next;
 	}
@@ -2046,6 +2145,7 @@ sub stepsnumber {
 	$lc++;
     }
     $step = int($lc/10) unless $step;
+    $progressbar->configure(-to => $step*10);
     seek(IN, 0, 0);
     return ($step, $timefound);
     
@@ -2121,8 +2221,7 @@ sub loadfileForDisplay {
 	    #$message =~ s/^\"(.*)\"$/$1/;
 	    &loadMessage($sender, $message, $time);
 	    #print "sender=$sender message=$message step=$step line=$line\n";
-	    $progressbar->value($line);
-	    $progressbar->update if ($step == 0 or $line % $step == 0);
+	    &setProgressbar($line, $step);
 	}
     }
     &afterUpdatingMessages;
@@ -2296,8 +2395,7 @@ sub loadfileForReplay {
 	    }, $ti]);
 	    &replayStart if $replay_was_running;
 	}, $time]);
-        $progressbar->value($line);
-        $progressbar->update if ($step == 0 or $line % $step == 0);
+	&setProgressbar($line, $step);
     }
     $replay_tpl->raise;
     $replay_time = $replay_min_time;
@@ -2343,7 +2441,7 @@ sub savefile {
 					       ['All Files',   '*']],
     				);
     return unless $file;
-
+    &showProgressbar();
     # disable other buttons
     my $jumpstate = $jumpButton->cget(-state);
     my $startstate = $startButton->cget(-state);
@@ -2357,6 +2455,7 @@ sub savefile {
     $mw->update;
 
     my $restorestate = sub {
+	&hideProgressbar();
 	# restore other buttons state
 	$loadButton->configure(-state => 'normal');
 	$saveButton->configure(-state => 'normal');
@@ -2411,22 +2510,50 @@ sub save {
   	my $messages = $messagesText->get($index, "$index + 100 lines");
   	$index = "$index + 100 lines";
 	unless ($messages) {
-	    $progressbar->value($nblines);
+	    &setProgressbar($nblines);
 	    $progressbar->update;
 	    last;
 	}
   	print OUT $messages or return;
-	$progressbar->value($counter);
+	&setProgressbar($counter);
 	$counter += 100;
 	$progressbar->update if ($step == 0 or $counter % $step == 0);
     }
-    $progressbar->value(0);
+    &setProgressbar(0); 
     $mw->after(300, sub {$tpl->destroy;});
     $tpl->waitWindow;
     return 1;
     
 } # end save
 
+
+sub showProgressbar {
+
+    $progressbar->value(0);
+    $progressbar->toplevel->deiconify;
+    $progressbar->toplevel->raise($mw);
+
+} # end showProgressbar
+
+
+sub hideProgressbar {
+    
+    $progressbar->toplevel->withdraw;
+    
+} # end hideProgressbar
+
+
+sub setProgressbar {
+
+    my ($line, $step) = @_;
+    $progressbar->value($line);
+    $progressbar->toplevel->raise($mw);
+    return unless defined $step;
+    $progressbar->update if ($step == 0 or $line % $step == 0);
+
+} # end setProgressbar
+
+
 #----------------------------------------------------------------------------------
 # Functions related to replay 
 #----------------------------------------------------------------------------------