diff options
Diffstat (limited to 'src')
| -rwxr-xr-x | src/ivymon | 239 |
1 files changed, 183 insertions, 56 deletions
@@ -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 #---------------------------------------------------------------------------------- |