diff options
Diffstat (limited to 'src')
| -rwxr-xr-x | src/ivymon | 2230 |
1 files changed, 1121 insertions, 1109 deletions
@@ -19,47 +19,49 @@ 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]); + 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]); } @@ -88,10 +90,11 @@ use Carp; use strict; use Getopt::Long; use Tk::CmdLine; -use vars qw/$VERSION $opt_help $opt_b $opt_bus $opt_history @opt_bind @opt_send $opt_size - $opt_undersize $opt_out $opt_loadingmode $opt_replayrepeat $opt_replaystartregexp - $opt_replaystopregexp $opt_replaytimegranularity $opt_debug/; -# **** VERSION *** +use vars qw/$VERSION $opt_help $opt_b $opt_bus $opt_history @opt_bind + @opt_send $opt_size $opt_undersize $opt_out $opt_loadingmode + $opt_replayrepeat $opt_replaystartregexp + $opt_replaystopregexp $opt_replaytimegranularity $opt_debug/; +# **** VERSION **** $VERSION = '1.17'; # options initialisation @@ -217,10 +220,10 @@ Tk::CmdLine::SetArguments(-font => '7x14'); Tk::CmdLine::SetArguments(); if (not GetOptions('-help', '-history=s', '-b=s', '-bus=s', '-bind=s@', - '-send=s@', '-size=s', '-undersize', '-loadingmode=s', - '-replayrepeat', '-replaystartregexp=s', '-debug', - '-replaytimegranularity=s', - '-replaystopregexp=s', '-out=s') or $opt_help) { + '-send=s@', '-size=s', '-undersize', '-loadingmode=s', + '-replayrepeat', '-replaystartregexp=s', '-debug', + '-replaytimegranularity=s', + '-replaystopregexp=s', '-out=s') or $opt_help) { print "\n"; print "IvyMon version $VERSION\n"; print "\n"; @@ -297,49 +300,49 @@ push(@send_def, @opt_send); #=================================== # -# Size options +# Size options if($opt_size eq "UXGA" || $opt_size eq "1600") { - $minW = 1600; - $minH = 1200; - $smallsized = 0; - $coef = 1.2; - Tk::CmdLine::SetArguments(-font => '10x20'); - Tk::CmdLine::SetArguments(); + $minW = 1600; + $minH = 1200; + $smallsized = 0; + $coef = 1.2; + Tk::CmdLine::SetArguments(-font => '10x20'); + Tk::CmdLine::SetArguments(); }elsif($opt_size eq "SXGA" || $opt_size eq "1280") { - $minW = 1280; - $minH = 1024; - $smallsized = 0; - $coef = 1.1; - Tk::CmdLine::SetArguments(-font => '8x13'); - Tk::CmdLine::SetArguments(); + $minW = 1280; + $minH = 1024; + $smallsized = 0; + $coef = 1.1; + Tk::CmdLine::SetArguments(-font => '8x13'); + Tk::CmdLine::SetArguments(); }elsif($opt_size eq "XGA" || $opt_size eq "1024") { - $minW = 1024; - $minH = 768; - $smallsized = 1; - $coef = 1; - Tk::CmdLine::SetArguments(-font => '7x14'); - Tk::CmdLine::SetArguments(); + $minW = 1024; + $minH = 768; + $smallsized = 1; + $coef = 1; + Tk::CmdLine::SetArguments(-font => '7x14'); + Tk::CmdLine::SetArguments(); }elsif($opt_size eq "SVGA" || $opt_size eq "800") { - $minW = 800; - $minH = 600; - $smallsized = 1; - $coef = 0.64; - Tk::CmdLine::SetArguments(-font => '6x10'); - Tk::CmdLine::SetArguments(); + $minW = 800; + $minH = 600; + $smallsized = 1; + $coef = 0.64; + Tk::CmdLine::SetArguments(-font => '6x10'); + Tk::CmdLine::SetArguments(); }elsif($opt_size eq "VGA" || $opt_size eq "640"){ - $minW = 640; - $minH = 480; - $smallsized = 1; - $coef = 0.48; - Tk::CmdLine::SetArguments(-font => '5x7'); - Tk::CmdLine::SetArguments(); + $minW = 640; + $minH = 480; + $smallsized = 1; + $coef = 0.48; + Tk::CmdLine::SetArguments(-font => '5x7'); + Tk::CmdLine::SetArguments(); } if($opt_undersize) { - $minW -= 10; - $minH -= 30; + $minW -= 10; + $minH -= 30; } #================================================================================= @@ -389,77 +392,77 @@ $mw->bind("Tk::Text", "<FocusIn>", [sub { # create balloon help widget my $balloonhelp = $mw->Balloon(-balloonposition => 'mouse', - -state => 'none', - ); + -state => 'none', + ); # create base frames my $top_fm = $mw->Frame()->pack(-fill => 'both', - -side => 'top', - -expand => 1, - -padx => 5*$coef, -pady => 5*$coef); - + -side => 'top', + -expand => 1, + -padx => 5*$coef, -pady => 5*$coef); + my $bottom_fm = $mw->Frame()->pack(-fill => 'both', - -side => 'bottom', - -expand => 0, - -padx => 5*$coef, -pady => 5*$coef, - ); + -side => 'bottom', + -expand => 0, + -padx => 5*$coef, -pady => 5*$coef, + ); my $bindings_fm = $bottom_fm->LabFrame(-label => 'Bindings : ', - -labelside => 'acrosstop', - -borderwidth => 3)->pack(-fill => 'both', - -side => 'left', - -padx => 5*$coef, - -expand => 0, - ); + -labelside => 'acrosstop', + -borderwidth => 3)->pack(-fill => 'both', + -side => 'left', + -padx => 5*$coef, + -expand => 0, + ); my $clients_fm = $bottom_fm->LabFrame(-label => 'Applications : ', - -labelside => 'acrosstop', - -borderwidth => 3)->pack(-fill => 'both', - -side => 'left', - -expand => 0, - -padx => 5*$coef, - ); + -labelside => 'acrosstop', + -borderwidth => 3)->pack(-fill => 'both', + -side => 'left', + -expand => 0, + -padx => 5*$coef, + ); my $send_fm = $bottom_fm->eLabFrame(-label => ' Messages to send : ', - -buttonbmp => $enlargebmp, - -labelside => 'acrosstop', - -borderwidth => 3)->pack(-fill => 'x', - -side => 'left', - -expand => 1, - -padx => 5*$coef, - ); + -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); - } - }); + -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', - -expand => 0); + -side => 'right', + -expand => 0); my $search_fm = $searchandcontrol_fm->LabFrame(-label => 'Search : ', - -labelside => 'acrosstop', - -borderwidth => 3)->pack(-fill => 'none', - -side => 'top', - -padx => 5*$coef, - -expand => 0); + -labelside => 'acrosstop', + -borderwidth => 3)->pack(-fill => 'none', + -side => 'top', + -padx => 5*$coef, + -expand => 0); my $control_fm = $searchandcontrol_fm->LabFrame(-label => 'Control : ', - -labelside => 'acrosstop', - -borderwidth => 3)->pack(-fill => 'none', - -side => 'bottom', - -padx => 5*$coef, - -expand => 0); + -labelside => 'acrosstop', + -borderwidth => 3)->pack(-fill => 'none', + -side => 'bottom', + -padx => 5*$coef, + -expand => 0); #---------------------------------------------------------------------------------- # Progress bar @@ -469,16 +472,17 @@ $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, - ); +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; @@ -486,56 +490,56 @@ $tpl->withdraw; # Messages display area #---------------------------------------------------------------------------------- my $top2_fm = $top_fm->Frame()->pack(-side => 'top', - -fill => 'x', - ); + -fill => 'x', + ); my $messagesLabel = $top2_fm->Label(-text => "Messages :")->pack(-side => 'left'); my $messagesCounterValue = $top2_fm->Label(-textvariable => \$recordedNumber, - -width => 8, - -anchor => 'w')->pack(-side => 'right'); + -width => 8, + -anchor => 'w')->pack(-side => 'right'); my $messagesCounterLabel = $top2_fm->Label(-text => "Recorded :", - -width => 15, - -anchor => 'e')->pack(-side => 'right'); + -width => 15, + -anchor => 'e')->pack(-side => 'right'); my $messagesBufdValue = $top2_fm->Label(-textvariable => \$bufNumber, - -width => 8, - -anchor => 'w')->pack(-side => 'right'); + -width => 8, + -anchor => 'w')->pack(-side => 'right'); my $messagesBufLabel = $top2_fm->Label(-text => "Bufferized :", - -width => 17, - -anchor => 'e')->pack(-side => 'right'); + -width => 17, + -anchor => 'e')->pack(-side => 'right'); my $messagesDeletedValue = $top2_fm->Label(-textvariable => \$deletedNumber, - -width => 8, - -anchor => 'w')->pack(-side => 'right'); + -width => 8, + -anchor => 'w')->pack(-side => 'right'); my $messagesDeletedLabel = $top2_fm->Label(-text => "Skipped :", - -width => 14, - -anchor => 'e')->pack(-side => 'right'); + -width => 14, + -anchor => 'e')->pack(-side => 'right'); my $messagesMaxLabel = $top2_fm->Label(-text => "Recordable : $history", - -width => 25)->pack(-side => 'right'); + -width => 25)->pack(-side => 'right'); my $messagesText = $top_fm->Scrolled('Text', - -scrollbars => 'e', - -height => 18*$coef, - -spacing1 => 2, - -spacing2 => 0, - -spacing3 => 2, - -state => 'disabled', - )->pack(-fill => 'both', - -expand => 1, - -side => 'bottom'); + -scrollbars => 'e', + -height => 18*$coef, + -spacing1 => 2, + -spacing2 => 0, + -spacing3 => 2, + -state => 'disabled', + )->pack(-fill => 'both', + -expand => 1, + -side => 'bottom'); $focusedtext = $messagesText; &wheelmousebindings($messagesText); @@ -546,8 +550,8 @@ my $bgcolor = $messagesText->cget(-background); # text tag creation $messagesText->tagConfigure('sender', - -background => 'gray50', - -foreground => 'gray90'); + -background => 'gray50', + -foreground => 'gray90'); my @hide_option; if ($Tk::VERSION ge 804) { @hide_option = (-elide => 1); @@ -557,15 +561,15 @@ if ($Tk::VERSION ge 804) { $messagesText->tagConfigure('time', @hide_option); $messagesText->tagConfigure($appname, -foreground => 'gray30'); $messagesText->tagConfigure('marker0', -background => 'lightcoral', - -foreground => 'lightcoral'); + -foreground => 'lightcoral'); $messagesText->tagConfigure('marker1', -background => 'LightGoldenrod', - -foreground => 'LightGoldenrod'); + -foreground => 'LightGoldenrod'); $messagesText->tagConfigure('marker2', -background => 'skyblue', - -foreground => 'skyblue'); + -foreground => 'skyblue'); $messagesText->tagConfigure('marker3', -background => 'darkseagreen', - -foreground => 'darkseagreen'); + -foreground => 'darkseagreen'); $messagesText->tagConfigure('marker4', - -background => 'ivory', -foreground => 'ivory'); + -background => 'ivory', -foreground => 'ivory'); for my $marker (qw(marker0 marker1 marker2 marker3 marker4)) { $messagesText->tagBind($marker, '<Double-1>', \&marker); @@ -578,17 +582,17 @@ $messagesCounterValue->repeat(1000, sub { $messagesLastNumber = $messagesNumber; # if update mechanism is off, we flush data here if ($noUpdateFlag) { - $messagesText->see('end'); - $messagesCounterValue->update; + $messagesText->see('end'); + $messagesCounterValue->update; } # if too many messages, update mechanism is unset if ($messagesSpeed > 50) { - $noUpdateFlag = 1; - #print "$messagesSpeed received messages/second !\n"; + $noUpdateFlag = 1; + #print "$messagesSpeed received messages/second !\n"; # in nominal case, update mechanism is set # (each time a message is received, update is forced in Text window) } else { - $noUpdateFlag = 0; + $noUpdateFlag = 0; } }); @@ -597,11 +601,11 @@ $messagesCounterValue->repeat(1000, sub { #---------------------------------------------------------------------------------- my $bindingsEntry = $bindings_fm->Entry(-width => 30*$coef)->pack(-fill => 'x', - -side => 'top', - -anchor => 'w', - -ipady => 3, - -expand => 0, - -pady => 5*$coef); + -side => 'top', + -anchor => 'w', + -ipady => 3, + -expand => 0, + -pady => 5*$coef); $bindingsEntry->bind('<Escape>' => [\&addBindingExpression]); $bindingsEntry->bind('<Return>' => [\&addBinding]); @@ -614,24 +618,24 @@ $bindingsEntry->focus; my $bindingsList = $bindings_fm->Scrolled('Listbox', - -scrollbars => 'osoe', - -height => 4, - -width => 30*$coef)->pack(-fill => 'y', - -side => 'top', - -anchor => 'w', - -expand => 0); + -scrollbars => 'osoe', + -height => 4, + -width => 30*$coef)->pack(-fill => 'y', + -side => 'top', + -anchor => 'w', + -expand => 0); $bindingsList->bind('<1>', [\&selectBinding]); $bindingsList->bind('<Double-1>', [\&addBinding]); $bindingsEntry->bind('<Key>' => [\&findExprInList, $bindingsList]); my $effectivebindingsList = $bindings_fm->Scrolled('Listbox', - -scrollbars => 'osoe', - -height => 4, - -width => 30*$coef)->pack(-fill => 'y', - -side => 'bottom', - -anchor => 'w', - -expand => 1); + -scrollbars => 'osoe', + -height => 4, + -width => 30*$coef)->pack(-fill => 'y', + -side => 'bottom', + -anchor => 'w', + -expand => 1); $effectivebindingsList->bind('<Double-1>', [\&removeBinding]); &wheelmousebindings($bindingsList); @@ -641,10 +645,10 @@ $effectivebindingsList->bind('<Double-1>', [\&removeBinding]); #---------------------------------------------------------------------------------- my $clientsListbox = $clients_fm->Scrolled('Listbox', - -height => 9, - -scrollbars => 'osoe')->pack(-fill => 'both', - -expand => 0, - -side => 'top'); + -height => 9, + -scrollbars => 'osoe')->pack(-fill => 'both', + -expand => 0, + -side => 'top'); $clientsListbox->bind('<1>', [\&selectClient]); $clientsListbox->bind('<Double-1>', [\&showClientBindings]); &wheelmousebindings($clientsListbox); @@ -656,85 +660,89 @@ my $clientsButtons_fm = my $clientsSeeBindings_btn = $clientsButtons_fm->Button(-command => [\&showClientBindings], - -text => 'See bindings', - )->pack(-side => 'top', -fill => 'both', -expand => 1); + -text => 'See bindings', + )->pack(-side => 'top', -fill => 'both', + -expand => 1); my $clientsButtons2_fm = - $clientsButtons_fm->Frame()->pack(-fill => 'both', -expand => 1, -side => 'top'); + $clientsButtons_fm->Frame()->pack(-fill => 'both', -expand => 1, + -side => 'top'); my $clientsFilter_btn = $clientsButtons2_fm->Button(-command => [\&filterClient], - -text => "Filter", - )->pack(-side => 'left', -fill => 'both', -expand => 1); + -text => "Filter", + )->pack(-side => 'left', -fill => 'both', + -expand => 1); my $clientsKill_btn = $clientsButtons2_fm->Button(-command => [\&killClient], - -text => "Kill", - )->pack(-side => 'left', -fill => 'both', -expand => 1); + -text => "Kill", + )->pack(-side => 'left', -fill => 'both', + -expand => 1); #---------------------------------------------------------------------------------- # Messages to send area #---------------------------------------------------------------------------------- my $send1_fm = $send_fm->Frame()->pack(-side => 'top', - -expand => 1, - -fill => 'both'); + -expand => 1, + -fill => 'both'); my $sendEntry = $send1_fm->Entry(-width => 40*$coef)->pack(-fill => 'x', - -side => 'left', - -anchor => 'w', - -ipady => 3, - -expand => 1, - -pady => 0); + -side => 'left', + -anchor => 'w', + -ipady => 3, + -expand => 1, + -pady => 0); my $recipientLabel = $send1_fm->Label(-width => 2, - -relief => 'sunken')->pack(-fill => 'x', - -side => 'left', - -anchor => 'w', - -ipady => 3, - -pady => 0); + -relief => 'sunken')->pack(-fill => 'x', + -side => 'left', + -anchor => 'w', + -ipady => 3, + -pady => 0); my $send2_fm = $send_fm->Frame()->pack(-side => 'top', - -pady => 5*$coef, - -expand => 1, - -fill => 'both'); + -pady => 5*$coef, + -expand => 1, + -fill => 'both'); my $clockstartButtonmsg = "Clock Start"; my $clockstopButtonmsg = "Clock Stop"; my $clockbackCheckButtonmsg = "Backward"; if($smallsized){ -# $clockstartButtonmsg = "Start"; - $clockstartButtonmsg = "Go"; - $clockstopButtonmsg = "Stop"; - $clockbackCheckButtonmsg = "Backw"; +# $clockstartButtonmsg = "Start"; + $clockstartButtonmsg = "Go"; + $clockstopButtonmsg = "Stop"; + $clockbackCheckButtonmsg = "Backw"; } my $clockstartButton = $send2_fm->Button(-height => 1, - -command => [\&clockstart], - -text => $clockstartButtonmsg)->grid(-column => 1, - -row => 1); + -command => [\&clockstart], + -text => $clockstartButtonmsg)->grid(-column => 1, + -row => 1); my $clockstopButton = $send2_fm->Button(-height => 1, - -command => [\&clockstop], - -text => $clockstopButtonmsg)->grid(-column => 2, - -row => 1); + -command => [\&clockstop], + -text => $clockstopButtonmsg)->grid(-column => 2, + -row => 1); my $clockbackCheckbutton = $send2_fm->Checkbutton(-selectcolor => undef, - -indicatoron => 0, - -command => [\&clockswitch], - -variable => \$clockbackwardflag, - -text => $clockbackCheckButtonmsg)->grid(-column => 3, - -row => 1, - -ipadx => 10*$coef, - -sticky => 'nsew'); + -command => [\&clockswitch], + -variable => \$clockbackwardflag, + -text => $clockbackCheckButtonmsg, + -indicatoron => 0)->grid(-column => 3, + -row => 1, + -ipadx => 10*$coef, + -sticky => 'nsew'); my $sendList = $send_fm->Scrolled('Listbox', - -scrollbars => 'osoe', - -height => 9, - -width => 40*$coef)->pack(-fill => 'both', - -anchor => 'w', - -side => 'top', - -expand => 1); + -scrollbars => 'osoe', + -height => 9, + -width => 40*$coef)->pack(-fill => 'both', + -anchor => 'w', + -side => 'top', + -expand => 1); $sendEntry->bind('<Key>' => [\&findExprInList, $sendList]); $sendEntry->bind('<Return>' => [\&addMsgToSend, undef, 1]); @@ -753,12 +761,12 @@ $sendList->bind('<Double-1>', [\&addMsgToSend, undef, 1]); #---------------------------------------------------------------------------------- my $searchEntry = $search_fm->Entry(-width => 24)->grid(-column => 1, - -row => 1, - -columnspan => 3); + -row => 1, + -columnspan => 3); $searchEntry->eventAdd('<<SearchNext>>', '<Return>', '<Next>', - '<Control-s>', '<Control-f>'); + '<Control-s>', '<Control-f>'); $searchEntry->eventAdd('<<SearchPrev>>', '<Shift-Return>', '<Prior>', - '<Control-r>'); + '<Control-r>'); $searchEntry->eventAdd('<<SearchNextExpr>>', '<Down>', '<Control-n>'); $searchEntry->eventAdd('<<SearchPrevExpr>>', '<Up>', '<Control-p>'); @@ -770,37 +778,37 @@ $searchEntry->bind('<Key>' => [\&searchOnTheFly]); my $checkbutt_fm = $search_fm->Frame()->grid(-column => 1, - -row => 2, - -columnspan => 3); + -row => 2, + -columnspan => 3); my $casesensitive_cb = $checkbutt_fm->Checkbutton(-text => 'Case sens.', - -variable => \$casesensitiveflag - )->grid(-column => 1, - -row => 1); + -variable => \$casesensitiveflag + )->grid(-column => 1, + -row => 1); my $regexp_cb = $checkbutt_fm->Checkbutton(-text => 'Regexp', - -variable => \$regexpflag - )->grid(-column => 2, - -row => 1); + -variable => \$regexpflag + )->grid(-column => 2, + -row => 1); my $searchPrev = $search_fm->Button(-text => 'Prev', - -height => 1, - -width => 4, - -command => [\&searchPrev])->grid(-column => 1, - -row => 3); + -height => 1, + -width => 4, + -command => [\&searchPrev])->grid(-column => 1, + -row => 3); my $searchNext = $search_fm->Button(-text => 'Next', - -width => 4, - -height => 1, - -command => [\&searchNext])->grid(-column => 2, - -row => 3); + -width => 4, + -height => 1, + -command => [\&searchNext])->grid(-column => 2, + -row => 3); my $searchAll = $search_fm->Button(-text => 'All', - -width => 4, - -height => 1, - -command => [\&searchAll])->grid(-column => 3, - -row => 3); + -width => 4, + -height => 1, + -command => [\&searchAll])->grid(-column => 3, + -row => 3); #---------------------------------------------------------------------------------- # Control panel #---------------------------------------------------------------------------------- @@ -808,68 +816,68 @@ my $searchAll = my $balloonflag = 0; my $balloon_cb = $control_fm->Checkbutton(-text => 'Balloon help', - -variable => \$balloonflag, - -command => sub { - if ($balloonflag == 0) { - $balloonhelp->configure(-state => 'none'); - } else { - $balloonhelp->configure(-state => 'balloon'); - } - } - ); + -variable => \$balloonflag, + -command => sub { + if ($balloonflag == 0) { + $balloonhelp->configure(-state => 'none'); + } else { + $balloonhelp->configure(-state => 'balloon'); + } + } + ); $balloon_cb->grid(-column => 1, - -columnspan => 2, - -row => 1); + -columnspan => 2, + -row => 1); my $exitButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&bye], - -text => 'Exit')->grid(-column => 3, - -row => 1); + -width => 4, + -command => [\&bye], + -text => 'Exit')->grid(-column => 3, + -row => 1); my $loadButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&loadfile, 1], - -state => 'normal', - -text => 'Load')->grid(-column => 1, - -row => 2); + -width => 4, + -command => [\&loadfile, 1], + -state => 'normal', + -text => 'Load')->grid(-column => 1, + -row => 2); my $saveButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&savefile, 1], - -state => 'normal', - -text => 'Save')->grid(-column => 2, - -row => 2); + -width => 4, + -command => [\&savefile, 1], + -state => 'normal', + -text => 'Save')->grid(-column => 2, + -row => 2); my $jumpButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&jump], - -state => 'disabled', - -text => 'Jump')->grid(-column => 3, - -row => 2); + -width => 4, + -command => [\&jump], + -state => 'disabled', + -text => 'Jump')->grid(-column => 3, + -row => 2); my $startButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&start, 1], - -state => 'disabled', - -text => 'Scroll')->grid(-column => 1, - -row => 3); + -width => 4, + -command => [\&start, 1], + -state => 'disabled', + -text => 'Scroll')->grid(-column => 1, + -row => 3); my $stopButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&stop, 1], - -text => "Scroll\nLock")->grid(-column => 2, - -row => 3); + -width => 4, + -command => [\&stop, 1], + -text => "Scroll\nLock")->grid(-column => 2, + -row => 3); my $clearButton = $control_fm->Button(-height => 2, - -width => 4, - -command => [\&clear, 1], - -state => 'normal', - -text => 'Clear')->grid(-column => 3, - -row => 3); + -width => 4, + -command => [\&clear, 1], + -state => 'normal', + -text => 'Clear')->grid(-column => 3, + -row => 3); #---------------------------------------------------------------------------------- # Update default bindings and messages lists #---------------------------------------------------------------------------------- @@ -903,98 +911,98 @@ my $insertionText = "next rvalue field, and select it if defined. "; $balloonhelp->attach($messagesMaxLabel, -balloonmsg => - "Maximum number of recordable messages\n". - "(=history size value) " - ); + "Maximum number of recordable messages\n". + "(=history size value) " + ); $balloonhelp->attach($messagesDeletedLabel, -balloonmsg => - "Counter for received messages which are\n". - "skipped when history size is reached. " - ); + "Counter for received messages which are\n". + "skipped when history size is reached. " + ); $balloonhelp->attach($messagesBufLabel, -balloonmsg => - "Counter for received messages which are bufferized\n". - "when [Scroll Lock] button is active. They will be \n". - "displayed when user will restore scroll mode. " - ); + "Counter for received messages which are bufferized\n". + "when [Scroll Lock] button is active. They will be \n". + "displayed when user will restore scroll mode. " + ); $balloonhelp->attach($messagesCounterLabel, -balloonmsg => - "Counter for received and displayed messages." - ); + "Counter for received and displayed messages." + ); $balloonhelp->attach($bindingsEntry, -balloonmsg => - "This input field is used to enter new bindings or\n". - "edit default one from list above. In both case, \n". - "hit [Enter] to apply. \n". - $historyText."\n". - $completionText."\n". - $insertionText - ); + "This input field is used to enter new bindings or\n". + "edit default one from list above. In both case, \n". + "hit [Enter] to apply. \n". + $historyText."\n". + $completionText."\n". + $insertionText + ); $balloonhelp->attach($bindingsList, -balloonmsg => - "Available bindings list. Select an item for edition or\n". - "double-click on a predefined binding to activate it. " - ); + "Available bindings list. Select an item for edition or\n". + "double-click on a predefined binding to activate it. " + ); $balloonhelp->attach($effectivebindingsList, -balloonmsg => - "Effective bindings list. Double-click on binding to unset it." - ); + "Effective bindings list. Double-click on binding to unset it." + ); $balloonhelp->attach($clientsListbox,-balloonmsg => - "Select an application name to highlight related\n". - "Ivy messages in the Messages area. \n". - "Double-click on it to display the application \n". - "bindings or click on the 'See bindings' button.\n". - "To display messages in a separate window, click\n". - "on the 'Filter' button. \n". - "To kill an agent, click on the 'Kill' button. "); + "Select an application name to highlight related\n". + "Ivy messages in the Messages area. \n". + "Double-click on it to display the application \n". + "bindings or click on the 'See bindings' button.\n". + "To display messages in a separate window, click\n". + "on the 'Filter' button. \n". + "To kill an agent, click on the 'Kill' button. "); $balloonhelp->attach($sendEntry, -balloonmsg => - "This input field is used to enter new messages or\n". - "edit default one from list above. In both case, \n". - "hit [Enter] to send it. \n". - $historyText."\n". - $completionText."\n". - $insertionText - ); + "This input field is used to enter new messages or\n". + "edit default one from list above. In both case, \n". + "hit [Enter] to send it. \n". + $historyText."\n". + $completionText."\n". + $insertionText + ); $balloonhelp->attach($sendList, -balloonmsg => - "Available messages list. Select an item for edition\n". - "or double click on predefined message to send it. " - ); + "Available messages list. Select an item for edition\n". + "or double click on predefined message to send it. " + ); $balloonhelp->attach($recipientLabel, -balloonmsg => - "Number of last message recipients." - ); + "Number of last message recipients." + ); $balloonhelp->attach($messagesText, -balloonmsg => - "You can insert colored marker by double-clicking on a \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. " - ); + "You can insert colored marker by double-clicking on a \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. " + ); $balloonhelp->attach($searchEntry, -balloonmsg => - "This input field is used to search expressions in \n". - "messages list. Hit [Return], [Ctrl-s] or [Ctrl-f]\n". - "key to search forward and [Shift-Return] or [Ctrl-r]\n". - "key to search backward. \n". - $historyText - ); + "This input field is used to search expressions in \n". + "messages list. Hit [Return], [Ctrl-s] or [Ctrl-f]\n". + "key to search forward and [Shift-Return] or [Ctrl-r]\n". + "key to search backward. \n". + $historyText + ); $balloonhelp->attach($stopButton, -balloonmsg => - "Stop scrolling in Messages area." - ); + "Stop scrolling in Messages area." + ); $balloonhelp->attach($startButton, -balloonmsg => - "Restart scrolling in Messages area." - ); + "Restart scrolling in Messages area." + ); $balloonhelp->attach($jumpButton, -balloonmsg => - "Access next marker in Messages area." - ); + "Access next marker in Messages area." + ); $balloonhelp->attach($clearButton, -balloonmsg => - "Remove messages displayed\n". - "in Messages area. " - ); + "Remove messages displayed\n". + "in Messages area. " + ); $balloonhelp->attach($loadButton, -balloonmsg => - "Load messages file and display\n". - "its content in Messages area. " - ); + "Load messages file and display\n". + "its content in Messages area. " + ); $balloonhelp->attach($saveButton, -balloonmsg => - "Save the content of Messages\n". - "area in a file. " - ); + "Save the content of Messages\n". + "area in a file. " + ); $balloonhelp->attach($sendEnlargeBtn, -balloonmsg => - "Click here to enlarge or shrink this frame" - ); + "Click here to enlarge or shrink this frame" + ); #================================================================================= # @@ -1008,7 +1016,7 @@ $balloonhelp->attach($sendEnlargeBtn, -balloonmsg => Ivy->init(-loopMode => 'TK', -appName => $appname, -ivyBus => $ivy_port, - -onDieFunc => [\&quit], + -onDieFunc => [\&quit], ); my $ivy = Ivy->new(-statusFunc => \&checkClientsStatus); $ivy->start; @@ -1025,31 +1033,31 @@ for my $bind (@effectivebind) { #================================================================================= # loading mode $mw->Tk::Error("syntax error : -loadingmode accepts 'replay', 'replay-pause' ". - "or 'display' value") + "or 'display' value") if ($opt_loadingmode ne 'replay' and $opt_loadingmode ne 'replay-pause' - and $opt_loadingmode ne 'display'); + and $opt_loadingmode ne 'display'); # load input files if (@ARGV > 0) { my $file = $ARGV[0]; if ( not open(IN, $file)) { - $mw->Tk::Error("Can't open file '$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) { - &loadfileForReplay($step); - } else { - $mw->Tk::Error("No time information in file '$file'. ". - "Can't be replayed."); - } - &replayStart() if $opt_loadingmode eq 'replay'; - } elsif ($opt_loadingmode eq 'display') { - &loadfileForDisplay($step); - } - &hideProgressbar(); - close(IN); + &showProgressbar(); + my ($step, $timefound) = &stepsnumber; + if ($opt_loadingmode eq 'replay-pause' or $opt_loadingmode eq 'replay') { + if ($timefound) { + &loadfileForReplay($step); + } else { + $mw->Tk::Error("No time information in file '$file'. ". + "Can't be replayed."); + } + &replayStart() if $opt_loadingmode eq 'replay'; + } elsif ($opt_loadingmode eq 'display') { + &loadfileForDisplay($step); + } + &hideProgressbar(); + close(IN); } } @@ -1066,36 +1074,36 @@ MainLoop; # Ivy functions #---------------------------------------------------------------------------------- sub addIvyBinding { - my $binding = shift; - #print "in addIvyBinding $binding\n"; - $ivy->bindRegexp($binding, [sub { - my $sender = shift; - my $message; - if (@_ > 1) { - for (my $i = 0; $i < @_; $i++) { - $_[$i] = '"'.$_[$i].'"'; - } - $message = join(' ', @_); - } else { - $message = shift; - } - $messagesNumber++; - my $time = gettimeofday(); - if ($stopFlag) { - &bufferizeMessages($sender, $message, $time); - } else { - &beforeUpdatingMessages; - &updateMessages($sender, $message, $time); - &afterUpdatingMessages; - } - }]); + my $binding = shift; + #print "in addIvyBinding $binding\n"; + $ivy->bindRegexp($binding, [sub { + my $sender = shift; + my $message; + if (@_ > 1) { + for (my $i = 0; $i < @_; $i++) { + $_[$i] = '"'.$_[$i].'"'; + } + $message = join(' ', @_); + } else { + $message = shift; + } + $messagesNumber++; + my $time = gettimeofday(); + if ($stopFlag) { + &bufferizeMessages($sender, $message, $time); + } else { + &beforeUpdatingMessages; + &updateMessages($sender, $message, $time); + &afterUpdatingMessages; + } + }]); } # end addIvyBinding sub removeIvyBinding { - my $binding = shift; - $ivy->bindRegexp($binding); + my $binding = shift; + $ivy->bindRegexp($binding); } # end removeIvyBinding @@ -1104,33 +1112,33 @@ sub removeIvyBinding { # Functions related to connected applications management #---------------------------------------------------------------------------------- sub checkClientsStatus { - my $appname = $_[3]; - my $status = $_[4]; - my $host; - my $regexp; - my $newapi; - $newapi = 1 if (($ivy_cvsrevision == 1 and $ivy_version ge 1.40) or - ($ivy_cvsrevision == 0 and $ivy_version ge 4.18)); - if ($newapi) { - $host = $_[5]; - $regexp = $_[6]; - } else { - $host = $_[5]; - $regexp = $host; - } - $appname =~ s/ /_/g; - if ($status eq 'died') { - &removeClient($appname, $host); - } elsif ($status eq 'new') { - &addClient($appname, $host); - } elsif ($status eq 'subscribing') { - $clientsBindings{$appname}->{$host}++; - &newBinding($regexp); - } elsif ($status eq 'unsubscribing') { - $clientsBindings{$appname}->{$host}--; - } else { - carp "In Ivymon, checkClientsStatus function, unknown status <$status>\n"; - } + my $appname = $_[3]; + my $status = $_[4]; + my $host; + my $regexp; + my $newapi; + $newapi = 1 if (($ivy_cvsrevision == 1 and $ivy_version ge 1.40) or + ($ivy_cvsrevision == 0 and $ivy_version ge 4.18)); + if ($newapi) { + $host = $_[5]; + $regexp = $_[6]; + } else { + $host = $_[5]; + $regexp = $host; + } + $appname =~ s/ /_/g; + if ($status eq 'died') { + &removeClient($appname, $host); + } elsif ($status eq 'new') { + &addClient($appname, $host); + } elsif ($status eq 'subscribing') { + $clientsBindings{$appname}->{$host}++; + &newBinding($regexp); + } elsif ($status eq 'unsubscribing') { + $clientsBindings{$appname}->{$host}--; + } else { + carp "In Ivymon, checkClientsStatus function, unknown status <$status>\n"; + } } # end checkClientsStatus @@ -1153,7 +1161,7 @@ sub removeClient { $connectedClients{$client}->{$host}-- if $connectedClients{$client}->{$host} > 0; my $num = 0; for my $host ((keys(%{$connectedClients{$client}}))) { - $num += $connectedClients{$client}->{$host}; + $num += $connectedClients{$client}->{$host}; } delete $clientsBindings{$client} if $num == 0; &manageClient($client, $host); @@ -1162,38 +1170,38 @@ sub removeClient { sub manageClient { - my $client = shift; - my $host = shift; - my $i = 0; - for ($clientsListbox->get(0, 'end')) { - if ($_ =~ /^$client/ or $_ =~ /-- $client/) { - $clientsListbox->delete($i); - last; - } - $i++; - } - my $num = 0; - for (values(%{$connectedClients{$client}})) { - $num += $_; - } - if ($num == 0) { - $clientsListbox->insert('end', "-- $client died"); - } elsif ($num == 1) { - $clientsListbox->insert($i, "$client on $host"); - } elsif ($num > 1) { - my $msg = "$client "; - for my $host ((keys(%{$connectedClients{$client}}))) { - if ($connectedClients{$client}->{$host} == 0) { - next; - } elsif ($connectedClients{$client}->{$host} == 1) { - $msg .= "on $host, "; - } else { - $msg .= "on $host($connectedClients{$client}->{$host}), "; - } - } - $msg =~ s/, $//; - $clientsListbox->insert($i, $msg); - } + my $client = shift; + my $host = shift; + my $i = 0; + for ($clientsListbox->get(0, 'end')) { + if ($_ =~ /^$client/ or $_ =~ /-- $client/) { + $clientsListbox->delete($i); + last; + } + $i++; + } + my $num = 0; + for (values(%{$connectedClients{$client}})) { + $num += $_; + } + if ($num == 0) { + $clientsListbox->insert('end', "-- $client died"); + } elsif ($num == 1) { + $clientsListbox->insert($i, "$client on $host"); + } elsif ($num > 1) { + my $msg = "$client "; + for my $host ((keys(%{$connectedClients{$client}}))) { + if ($connectedClients{$client}->{$host} == 0) { + next; + } elsif ($connectedClients{$client}->{$host} == 1) { + $msg .= "on $host, "; + } else { + $msg .= "on $host($connectedClients{$client}->{$host}), "; + } + } + $msg =~ s/, $//; + $clientsListbox->insert($i, $msg); + } } # end manageClient @@ -1210,120 +1218,121 @@ sub killClient { } # end killClient sub selectClient { - $messagesText->tagConfigure($selectedClient, -background => $bgcolor) - if $selectedClient; - my $selindex = $clientsListbox->curselection; - my $client = $clientsListbox->get($selindex); - $client =~ s/^-- //; - $client =~ s/\(\d+\)$//; - $client =~ s/\s.*//; - if ($selectedClient eq $client) { - $selectedClient = undef; - $clientsListbox->selectionClear($selindex); - return; - } - $messagesText->tagConfigure($client, -background => 'gray70'); - $selectedClient = $client; + $messagesText->tagConfigure($selectedClient, -background => $bgcolor) + if $selectedClient; + my $selindex = $clientsListbox->curselection; + my $client = $clientsListbox->get($selindex); + $client =~ s/^-- //; + $client =~ s/\(\d+\)$//; + $client =~ s/\s.*//; + if ($selectedClient eq $client) { + $selectedClient = undef; + $clientsListbox->selectionClear($selindex); + return; + } + $messagesText->tagConfigure($client, -background => 'gray70'); + $selectedClient = $client; } # end selectClient sub filterClient { - my $selindex = $clientsListbox->curselection; - return unless defined $selindex; - my $client = $clientsListbox->get($selindex); - $client =~ s/^-- //; - $client =~ s/\(\d+\)$//; - $client =~ s/\s.*//; - # si une fenetre client existe, on la raise - if (defined $clientsMessagesTpl{$client} and + my $selindex = $clientsListbox->curselection; + return unless defined $selindex; + my $client = $clientsListbox->get($selindex); + $client =~ s/^-- //; + $client =~ s/\(\d+\)$//; + $client =~ s/\s.*//; + # si une fenetre client existe, on la raise + if (defined $clientsMessagesTpl{$client} and Tk::Exists $clientsMessagesTpl{$client}) { - $clientsMessagesTpl{$client}->toplevel->raise; - return; - # sinon, on la crée - } else { - my $tpl = $mw->Toplevel; - $tpl->group($mw); - my $title = "$client messages"; - $tpl->title($title); - $tpl->Label(-text => $title)->pack(-side => 'top', - -padx => 10, - -pady => 10); - $clientsMessagesTpl{$client} = - $tpl->Scrolled('Text', - -scrollbars => 'e', - )->pack(-side => 'top', - -fill => 'both', - -expand => 1); - $clientsMessagesTpl{$client}->bind('<1>', sub { - $clientsMessagesTpl{$client}->Subwidget('scrolled')->focus;}); - - &wheelmousebindings($clientsMessagesTpl{$client}); - - $tpl->Button(-text => 'Close', - -command => [sub { - my $text = $clientsMessagesTpl{$client}->Subwidget('scrolled'); - if ($focusedtext eq $text) { - $focusedtext = $messagesText; - $messagesText->focus; - } - $clientsMessagesTpl{$client} = undef; - $tpl->destroy; - }], - )->pack(-side => 'top', - -padx => 10, - -pady => 10); - } - - my @list = $messagesText->tagRanges($client); - for (my $i=0; $i < @list; $i += 2) { - &updateClientMessages($client, $messagesText->get($list[$i], $list[$i+1])); - } - $clientsMessagesTpl{$client}->configure(-state => 'disabled'); + $clientsMessagesTpl{$client}->toplevel->raise; + return; + # sinon, on la crée + } else { + my $tpl = $mw->Toplevel; + $tpl->group($mw); + my $title = "$client messages"; + $tpl->title($title); + $tpl->Label(-text => $title)->pack(-side => 'top', + -padx => 10, + -pady => 10); + $clientsMessagesTpl{$client} = + $tpl->Scrolled('Text', + -scrollbars => 'e', + )->pack(-side => 'top', + -fill => 'both', + -expand => 1); + $clientsMessagesTpl{$client}->bind('<1>', sub { + $clientsMessagesTpl{$client}->Subwidget('scrolled')->focus;}); + + &wheelmousebindings($clientsMessagesTpl{$client}); + + $tpl->Button(-text => 'Close', + -command => [sub { + my $text = + $clientsMessagesTpl{$client}->Subwidget('scrolled'); + if ($focusedtext eq $text) { + $focusedtext = $messagesText; + $messagesText->focus; + } + $clientsMessagesTpl{$client} = undef; + $tpl->destroy; + }], + )->pack(-side => 'top', + -padx => 10, + -pady => 10); + } + + my @list = $messagesText->tagRanges($client); + for (my $i=0; $i < @list; $i += 2) { + &updateClientMessages($client, $messagesText->get($list[$i], $list[$i+1])); + } + $clientsMessagesTpl{$client}->configure(-state => 'disabled'); } # end filterClient sub showClientBindings { - my $selindex = $clientsListbox->curselection; - return unless defined $selindex; - - my $client = $clientsListbox->get($selindex); - $client =~ s/\(\d+\)$//; - $client =~ s/ on .*//; - my $tpl = $clientBindingsTpl{$client}; - $tpl->destroy if defined $tpl and Tk::Exists($tpl); - $tpl = $mw->Toplevel; - $clientBindingsTpl{$client} = $tpl; - my $title = "Ivy bindings of $client application"; - $tpl->title($title); - $tpl->Label(-text => $title)->pack(-side => 'top', - -padx => 10, - -pady => 10); - my $t = $tpl->Scrolled('Text', - -scrollbars => 'e', - )->pack(-side => 'top', - -fill => 'both', - -expand => 1); - $t->tagConfigure('0', -background => '#d4d4d4'); - $t->tagConfigure('1', -background => '#e5e5e5'); - my $i = 0; - for my $regexp (sort keys(%{$clientsBindings{$client}})) { - - $t->insert('end', $regexp."\n", $i % 2) - if $clientsBindings{$client}->{$regexp} > 0; - $i++; - } - $t->configure(-state => 'disabled'); - $tpl->Button(-text => 'Close', - -command => [sub {$tpl->destroy; - $clientsListbox->selectionClear($_[0]) - unless $client eq $selectedClient; - }, $selindex, $client], - )->pack(-side => 'top', - -padx => 10, - -pady => 10); + my $selindex = $clientsListbox->curselection; + return unless defined $selindex; + + my $client = $clientsListbox->get($selindex); + $client =~ s/\(\d+\)$//; + $client =~ s/ on .*//; + my $tpl = $clientBindingsTpl{$client}; + $tpl->destroy if defined $tpl and Tk::Exists($tpl); + $tpl = $mw->Toplevel; + $clientBindingsTpl{$client} = $tpl; + my $title = "Ivy bindings of $client application"; + $tpl->title($title); + $tpl->Label(-text => $title)->pack(-side => 'top', + -padx => 10, + -pady => 10); + my $t = $tpl->Scrolled('Text', + -scrollbars => 'e', + )->pack(-side => 'top', + -fill => 'both', + -expand => 1); + $t->tagConfigure('0', -background => '#d4d4d4'); + $t->tagConfigure('1', -background => '#e5e5e5'); + my $i = 0; + for my $regexp (sort keys(%{$clientsBindings{$client}})) { + + $t->insert('end', $regexp."\n", $i % 2) + if $clientsBindings{$client}->{$regexp} > 0; + $i++; + } + $t->configure(-state => 'disabled'); + $tpl->Button(-text => 'Close', + -command => [sub {$tpl->destroy; + $clientsListbox->selectionClear($_[0]) + unless $client eq $selectedClient; + }, $selindex, $client], + )->pack(-side => 'top', + -padx => 10, + -pady => 10); } # end showClientBindings @@ -1333,38 +1342,38 @@ sub showClientBindings { # Functions related to messages display management #---------------------------------------------------------------------------------- sub marker { - return if $noMessageYet; - my @markers = $messagesText->markNames; - my $foundmarker; - my @markers2; - for (@markers) { - push(@markers2, $_) if (/^ivymon/); - } - $jumpButton->configure(-state => 'disabled') if @markers2 == 0; - for(@markers2) { - my $comp = $messagesText->compare('current linestart', '==', $_); - if ($comp) { - $foundmarker = $_; - $jumpButton->configure(-state => 'disabled') if @markers2 == 1; - last; - } - } - if ($foundmarker) { - &deletemarker($foundmarker); - } else { - my $index = $messagesText->index('current linestart + 1 lines'); - my $nb = $markers_cnt % 5; - &addmarker($index, 'marker'.$nb); - $markers_cnt++; - } - + return if $noMessageYet; + my @markers = $messagesText->markNames; + my $foundmarker; + my @markers2; + for (@markers) { + push(@markers2, $_) if (/^ivymon/); + } + $jumpButton->configure(-state => 'disabled') if @markers2 == 0; + for(@markers2) { + my $comp = $messagesText->compare('current linestart', '==', $_); + if ($comp) { + $foundmarker = $_; + $jumpButton->configure(-state => 'disabled') if @markers2 == 1; + last; + } + } + if ($foundmarker) { + &deletemarker($foundmarker); + } else { + my $index = $messagesText->index('current linestart + 1 lines'); + my $nb = $markers_cnt % 5; + &addmarker($index, 'marker'.$nb); + $markers_cnt++; + } + } # end marker sub deletemarker { my $marker = shift; $messagesText->configure(-state => 'normal'); - $messagesText->delete($marker, "$marker lineend + 1 chars"); + $messagesText->delete($marker, "$marker lineend + 1 chars"); $messagesText->markUnset($marker); $messagesText->configure(-state => 'disabled'); @@ -1409,23 +1418,23 @@ sub updateMessages { # Unless file has been loaded, look at history : compare widget text lines # number with history size if ($loadedFileFlag) { - &loadMessage($sender, $message, $time); - $messagesText->update unless $noUpdateFlag; + &loadMessage($sender, $message, $time); + $messagesText->update unless $noUpdateFlag; } else { - my ($linesNb) = split(/\./, $messagesText->index('end')); - $linesNb--; - #print "linesNb=$linesNb\n"; - if ($linesNb > $history) { - $deletedNumber += 1; - if ($deletedNumber == 1) { - $messagesDeletedLabel->configure(-foreground => 'red'); - $messagesDeletedValue->configure(-foreground => 'red'); - } - } else { - &loadMessage($sender, $message, $time); - $messagesText->update unless $noUpdateFlag; - } + my ($linesNb) = split(/\./, $messagesText->index('end')); + $linesNb--; + #print "linesNb=$linesNb\n"; + if ($linesNb > $history) { + $deletedNumber += 1; + if ($deletedNumber == 1) { + $messagesDeletedLabel->configure(-foreground => 'red'); + $messagesDeletedValue->configure(-foreground => 'red'); + } + } else { + &loadMessage($sender, $message, $time); + $messagesText->update unless $noUpdateFlag; + } } } # end updateMessages @@ -1477,8 +1486,8 @@ sub afterUpdatingMessages { sub highlightString { my ($i1, $i2) = @_; $focusedtext->tagConfigure('found', - -background => 'sienna', - -foreground => 'ivory'); + -background => 'sienna', + -foreground => 'ivory'); $focusedtext->tagAdd('found', $i1, $i2); } # end highlightString @@ -1487,8 +1496,8 @@ sub highlightString { sub highlightStringOff { $focusedtext->tagDelete('found'); $focusedtext->tagConfigure('found', - -background => 'sienna', - -foreground => 'ivory'); + -background => 'sienna', + -foreground => 'ivory'); } # end highlightStringOff @@ -1503,17 +1512,17 @@ sub addBindingExpression { sub bindingNextExpression { - my $cursorIndex = $bindingsEntry->index('insert'); - $cursorIndex = -1 if $bindingsEntry->index('end') == $cursorIndex; - if ($bindHistoryIndex == -1 or $bindHistoryIndex == @bindHistory - 1 - or @bindHistory <= 1) { - &warning1($bindingsEntry); - } else { - $bindHistoryIndex++; - $bindingsEntry->delete(0, 'end'); - $bindingsEntry->insert(0, $bindHistory[$bindHistoryIndex]); - $bindingsEntry->icursor($cursorIndex) if $cursorIndex >= 0; - } + my $cursorIndex = $bindingsEntry->index('insert'); + $cursorIndex = -1 if $bindingsEntry->index('end') == $cursorIndex; + if ($bindHistoryIndex == -1 or $bindHistoryIndex == @bindHistory - 1 + or @bindHistory <= 1) { + &warning1($bindingsEntry); + } else { + $bindHistoryIndex++; + $bindingsEntry->delete(0, 'end'); + $bindingsEntry->insert(0, $bindHistory[$bindHistoryIndex]); + $bindingsEntry->icursor($cursorIndex) if $cursorIndex >= 0; + } } # end bindingNextExpression @@ -1522,16 +1531,16 @@ sub bindingPrevExpression { my $cursorIndex = $bindingsEntry->index('insert'); $cursorIndex = -1 if $bindingsEntry->index('end') == $cursorIndex; if ($bindHistoryIndex == 0 or @bindHistory <= 1) { - &warning1($bindingsEntry); + &warning1($bindingsEntry); } else { - if ($bindHistoryIndex == -1) { - $bindHistoryIndex = @bindHistory - 2; - } else { - $bindHistoryIndex--; - } - $bindingsEntry->delete(0, 'end'); - $bindingsEntry->insert(0, $bindHistory[$bindHistoryIndex]); - $bindingsEntry->icursor($cursorIndex) if $cursorIndex >= 0; + if ($bindHistoryIndex == -1) { + $bindHistoryIndex = @bindHistory - 2; + } else { + $bindHistoryIndex--; + } + $bindingsEntry->delete(0, 'end'); + $bindingsEntry->insert(0, $bindHistory[$bindHistoryIndex]); + $bindingsEntry->icursor($cursorIndex) if $cursorIndex >= 0; } } # end bindingPrevExpression @@ -1547,13 +1556,13 @@ sub clearBinding { sub addBinding { my ($sender, $entry) = @_; unless ($entry) { - $entry = $bindingsEntry->get; - return unless $entry; + $entry = $bindingsEntry->get; + return unless $entry; } &bindHistoryGenList($entry); if ($effectivebindings{$entry}) { - &warning2($bindingsEntry); - return ; + &warning2($bindingsEntry); + return ; } $effectivebindingsList->insert('end', "bound to ".$entry); $effectivebindings{$entry} = 1; @@ -1575,8 +1584,8 @@ sub addBindingInList { my $index = 0; my $i = 0; for (sort @content) { - $index = $i if $_ eq $entry; - $i++; + $index = $i if $_ eq $entry; + $i++; } $bindingsList->insert($index, $entry); &bindingsGenList; @@ -1613,29 +1622,29 @@ sub newBinding { my @expr; my $msgsnum = 1; while ($msg =~ /\((.*?\|.*?)\)/g) { - push(@expr, $1); - $msgsnum *= split(/\|/, $1); + push(@expr, $1); + $msgsnum *= split(/\|/, $1); } my @msgs; for (my $i=0; $i < $msgsnum; $i++) { - push(@msgs, $msg); + push(@msgs, $msg); } if ($msgsnum > 1) { - for my $expr (@expr) { - my (@field) = split(/\|/, $expr); - my $j = 0; - for (my $i=0; $i < @msgs; $i++) { - my $qmexpr = quotemeta($expr); - $msgs[$i] =~ s/\($qmexpr\)/$field[$j]/; - $j++; - $j = 0 if $j == @field; - } - } - for (@msgs) { - &addMsgToSend(undef, $_); - } + for my $expr (@expr) { + my (@field) = split(/\|/, $expr); + my $j = 0; + for (my $i=0; $i < @msgs; $i++) { + my $qmexpr = quotemeta($expr); + $msgs[$i] =~ s/\($qmexpr\)/$field[$j]/; + $j++; + $j = 0 if $j == @field; + } + } + for (@msgs) { + &addMsgToSend(undef, $_); + } } else { - &addMsgToSend(undef, $msg); + &addMsgToSend(undef, $msg); } } # end newBinding @@ -1670,13 +1679,13 @@ sub bindingsGenList { my $i = 0; my $found = 0; for (keys %bindingsIndex) { - delete $bindingsIndex{$_}; - delete $bindings{$_}; + delete $bindingsIndex{$_}; + delete $bindings{$_}; } for ($bindingsList->get(0, 'end')) { - $found = 1; - $bindingsIndex{$_} = $i++; - $bindings{$_} = 1 + $found = 1; + $bindingsIndex{$_} = $i++; + $bindings{$_} = 1 } $bindingsFlag = $found; @@ -1699,13 +1708,13 @@ sub sendNextExpression { my $cursorIndex = $sendEntry->index('insert'); $cursorIndex = -1 if $sendEntry->index('end') == $cursorIndex; if ($sendHistoryIndex == -1 or $sendHistoryIndex == @sendHistory - 1 - or @sendHistory <= 1) { - &warning1($sendEntry); + or @sendHistory <= 1) { + &warning1($sendEntry); } else { - $sendHistoryIndex++; - $sendEntry->delete(0, 'end'); - $sendEntry->insert(0, $sendHistory[$sendHistoryIndex]); - $sendEntry->icursor($cursorIndex) if $cursorIndex >= 0; + $sendHistoryIndex++; + $sendEntry->delete(0, 'end'); + $sendEntry->insert(0, $sendHistory[$sendHistoryIndex]); + $sendEntry->icursor($cursorIndex) if $cursorIndex >= 0; } } # end sendNextExpression @@ -1715,16 +1724,16 @@ sub sendPrevExpression { my $cursorIndex = $sendEntry->index('insert'); $cursorIndex = -1 if $sendEntry->index('end') == $cursorIndex; if ($sendHistoryIndex == 0 or @sendHistory <= 1) { - &warning1($sendEntry); + &warning1($sendEntry); } else { - if ($sendHistoryIndex == -1) { - $sendHistoryIndex = @sendHistory - 2; - } else { - $sendHistoryIndex--; - } - $sendEntry->delete(0, 'end'); - $sendEntry->insert(0, $sendHistory[$sendHistoryIndex]); - $sendEntry->icursor($cursorIndex) if $cursorIndex >= 0; + if ($sendHistoryIndex == -1) { + $sendHistoryIndex = @sendHistory - 2; + } else { + $sendHistoryIndex--; + } + $sendEntry->delete(0, 'end'); + $sendEntry->insert(0, $sendHistory[$sendHistoryIndex]); + $sendEntry->icursor($cursorIndex) if $cursorIndex >= 0; } } # end sendPrevExpression @@ -1733,8 +1742,8 @@ sub sendPrevExpression { sub addMsgToSend { my ($sender, $entry, $sendFlag) = @_; unless ($entry) { - $entry = $sendEntry->get; - return unless $entry; + $entry = $sendEntry->get; + return unless $entry; } &sendMsg($entry) if $sendFlag; &warning3($sendEntry); @@ -1745,8 +1754,8 @@ sub addMsgToSend { my $index = 0; my $i = 0; for (sort @content) { - $index = $i if $_ eq $entry; - $i++; + $index = $i if $_ eq $entry; + $i++; } $sendList->insert($index, $entry); &sendGenList; @@ -1785,13 +1794,13 @@ sub sendGenList { my $i = 0; my $found = 0; for (keys %msgToSendIndex) { - delete $msgToSendIndex{$_}; - delete $msgToSend{$_}; + delete $msgToSendIndex{$_}; + delete $msgToSend{$_}; } for ($sendList->get(0, 'end')) { - $found = 1; - $msgToSendIndex{$_} = $i++; - $msgToSend{$_} = 1 + $found = 1; + $msgToSendIndex{$_} = $i++; + $msgToSend{$_} = 1 } $msgToSendFlag = $found; @@ -1824,13 +1833,13 @@ sub clockstop { sub clockswitch { if ($clockbackwardflag == 1) { - &sendMsg("ClockBackward"); - $clockbackCheckbutton->configure(-foreground => 'maroon', - -activeforeground => 'maroon'); + &sendMsg("ClockBackward"); + $clockbackCheckbutton->configure(-foreground => 'maroon', + -activeforeground => 'maroon'); } else { - &sendMsg("ClockForward"); - $clockbackCheckbutton->configure(-foreground => 'black', - -activeforeground => 'black'); + &sendMsg("ClockForward"); + $clockbackCheckbutton->configure(-foreground => 'black', + -activeforeground => 'black'); } } # end clockswitch @@ -1843,13 +1852,13 @@ sub searchNextExpression { my $cursorIndex = $searchEntry->index('insert'); $cursorIndex = -1 if $searchEntry->index('end') == $cursorIndex; if ($searchHistoryIndex == -1 or $searchHistoryIndex == @searchHistory - 1 - or @searchHistory <= 1) { - &warning1($searchEntry); + or @searchHistory <= 1) { + &warning1($searchEntry); } else { - $searchHistoryIndex++; - $searchEntry->delete(0, 'end'); - $searchEntry->insert(0, $searchHistory[$searchHistoryIndex]); - $searchEntry->icursor($cursorIndex) if $cursorIndex >= 0; + $searchHistoryIndex++; + $searchEntry->delete(0, 'end'); + $searchEntry->insert(0, $searchHistory[$searchHistoryIndex]); + $searchEntry->icursor($cursorIndex) if $cursorIndex >= 0; } } # end searchNextExpression @@ -1859,16 +1868,16 @@ sub searchPrevExpression { my $cursorIndex = $searchEntry->index('insert'); $cursorIndex = -1 if $searchEntry->index('end') == $cursorIndex; if ($searchHistoryIndex == 0 or @searchHistory <= 1) { - &warning1($searchEntry); + &warning1($searchEntry); } else { - if ($searchHistoryIndex == -1) { - $searchHistoryIndex = @searchHistory - 2; - } else { - $searchHistoryIndex--; - } - $searchEntry->delete(0, 'end'); - $searchEntry->insert(0, $searchHistory[$searchHistoryIndex]); - $searchEntry->icursor($cursorIndex) if $cursorIndex >= 0; + if ($searchHistoryIndex == -1) { + $searchHistoryIndex = @searchHistory - 2; + } else { + $searchHistoryIndex--; + } + $searchEntry->delete(0, 'end'); + $searchEntry->insert(0, $searchHistory[$searchHistoryIndex]); + $searchEntry->icursor($cursorIndex) if $cursorIndex >= 0; } } # end searchPrevExpression @@ -1898,13 +1907,13 @@ sub searchOnTheFly { #print "string=$string\n"; my $index0; if ($searchString) { - if ($string ne $searchString) { - $index0 = $searchIndex; - } else { - return; - } + if ($string ne $searchString) { + $index0 = $searchIndex; + } else { + return; + } } else { - $index0 = '0.0'; + $index0 = '0.0'; } &highlightStringOff; my @searchopts = (-hidden, -count => \$strlen, -forwards); @@ -1913,13 +1922,13 @@ sub searchOnTheFly { my $index = $focusedtext->search(@searchopts, $string, $index0); #print "index=$index strlen=$strlen\n"; if ($index) { - &highlightStringOff if $searchString and $string eq $searchString; - $searchString = $focusedtext->get($index, "$index + $strlen chars"); - $searchIndex = $index; - &highlightString($index, "$index + $strlen chars"); - $focusedtext->see($index); + &highlightStringOff if $searchString and $string eq $searchString; + $searchString = $focusedtext->get($index, "$index + $strlen chars"); + $searchIndex = $index; + &highlightString($index, "$index + $strlen chars"); + $focusedtext->see($index); } else { - &warning2($focusedtext); + &warning2($focusedtext); } } # end searchOnTheFly @@ -1936,14 +1945,14 @@ sub searchNext { #print "index=$index searchIndex=$searchIndex strlen=$strlen\n"; &highlightStringOff; if ($index) { - &highlightString($index, "$index + $strlen chars"); - $focusedtext->see($index); - &warning1($focusedtext) if defined($searchIndex) and - $focusedtext->compare($index, "<=" ,$searchIndex); - $searchString = $focusedtext->get($index, "$index + $strlen chars"); - $searchIndex = $index; + &highlightString($index, "$index + $strlen chars"); + $focusedtext->see($index); + &warning1($focusedtext) if defined($searchIndex) and + $focusedtext->compare($index, "<=" ,$searchIndex); + $searchString = $focusedtext->get($index, "$index + $strlen chars"); + $searchIndex = $index; } else { - &warning2($focusedtext); + &warning2($focusedtext); } $searchHistoryIndex = -1; &searchHistoryGenList($string); @@ -1963,14 +1972,14 @@ sub searchPrev { my $index = $focusedtext->search(@searchopts, $string, $index0); &highlightStringOff; if ($index) { - &highlightString($index, "$index + $strlen chars"); - $focusedtext->see($index); - &warning1($focusedtext) if defined($searchIndex) and - $focusedtext->compare($index, ">=" ,$searchIndex); - $searchString = $focusedtext->get($index, "$index + $strlen chars"); - $searchIndex = $index; + &highlightString($index, "$index + $strlen chars"); + $focusedtext->see($index); + &warning1($focusedtext) if defined($searchIndex) and + $focusedtext->compare($index, ">=" ,$searchIndex); + $searchString = $focusedtext->get($index, "$index + $strlen chars"); + $searchIndex = $index; } else { - &warning2($focusedtext); + &warning2($focusedtext); } $searchHistoryIndex = -1; &searchHistoryGenList($string); @@ -1984,8 +1993,8 @@ sub searchAll { my $strlen; return unless $string; $focusedtext->tagConfigure('found', - -background => 'sienna', - -foreground => 'ivory'); + -background => 'sienna', + -foreground => 'ivory'); my $index = '0.0'; my $found = 0; my @searchopts = (-hidden, -count => \$strlen, -forwards); @@ -1993,11 +2002,11 @@ sub searchAll { push(@searchopts, -regexp) if ($regexpflag); while ($index) { - $index = $focusedtext->search(@searchopts, $string, $index, 'end'); - last unless $index; - $focusedtext->tagAdd('found', $index, "$index + $strlen chars"); - $index = "$index + 1 chars"; - $found++; + $index = $focusedtext->search(@searchopts, $string, $index, 'end'); + last unless $index; + $focusedtext->tagAdd('found', $index, "$index + $strlen chars"); + $index = "$index + 1 chars"; + $found++; } &warning2($focusedtext) unless ($found); $searchHistoryIndex = -1; @@ -2012,14 +2021,14 @@ sub searchAll { #---------------------------------------------------------------------------------- sub bye { if ($messagesNumber > 0) { - my $diag = $mw->Dialog(-text => - "Really quit Ivymon ?", - -default_button => 'OK', - -buttons => [qw(OK Cancel)]); - my $answer = $diag->Show; - if ($answer eq 'Cancel') { - return; - } + my $diag = $mw->Dialog(-text => + "Really quit Ivymon ?", + -default_button => 'OK', + -buttons => [qw(OK Cancel)]); + my $answer = $diag->Show; + if ($answer eq 'Cancel') { + return; + } } &quit; } @@ -2028,10 +2037,10 @@ sub jump { my @markers = $messagesText->markNames; my @markers2; for (@markers) { - push(@markers2, $_) if (/^ivymon/); + push(@markers2, $_) if (/^ivymon/); } if (@markers2 < $jump_cnt + 1) { - $jump_cnt = 0; + $jump_cnt = 0; } $messagesText->yview($markers2[$jump_cnt]); $jump_cnt++; @@ -2052,7 +2061,7 @@ sub stop { sub start { my $flag = shift; if ($messagesText->index('insert') !~ /\.0$/) { - $messagesText->insert('insert', "\n"); + $messagesText->insert('insert', "\n"); } # disable other buttons @@ -2068,8 +2077,8 @@ sub start { $noUpdateFlag = 1; &beforeUpdatingMessages; for my $msg (@messagesbuffer) { - &updateMessages($msg->[0], $msg->[1], $msg->[2]); - $bufNumber--; + &updateMessages($msg->[0], $msg->[1], $msg->[2]); + $bufNumber--; } &afterUpdatingMessages; $noUpdateFlag = 0; @@ -2087,14 +2096,14 @@ sub start { sub clear { if ($messagesNumber > 0) { - my $diag = $mw->Dialog(-text => - "Do you really want to remove displayed messages ?", - -default_button => 'OK', - -buttons => [qw(OK Cancel)]); - my $answer = $diag->Show; - if ($answer eq 'Cancel') { - return; - } + my $diag = $mw->Dialog(-text => + "Do you really want to remove displayed messages ?", + -default_button => 'OK', + -buttons => [qw(OK Cancel)]); + my $answer = $diag->Show; + if ($answer eq 'Cancel') { + return; + } } # disable other buttons @@ -2114,8 +2123,8 @@ sub clear { $recordedNumber = 0; #$messagesText->delete('1.0', 'end'); while ($messagesText->compare($messagesText->index('end'), ">", "2.0")) { - $messagesText->delete('1.0', '1000.0'); - my $index = $messagesText->index('end'); + $messagesText->delete('1.0', '1000.0'); + my $index = $messagesText->index('end'); } $messagesText->configure(-state => 'disabled'); @@ -2135,34 +2144,34 @@ sub clear { sub loadfile { my $file = $mw->getOpenFile(-filetypes => [['Ivy Files', '.ivy'], - ['All Files', '*']], - ); + ['All Files', '*']], + ); return unless $file; # open file unless (open(IN, "$file")) { - $mw->Tk::Error("$!\n"); - return; + $mw->Tk::Error("$!\n"); + return; } my $loadingmode = 'display'; &showProgressbar(); my ($step, $timefound) = &stepsnumber(); if ($timefound) { - $loadingmode = &selectLoadingMode(); - if ($loadingmode eq 'replay') { - &loadfileForReplay($step); - } else { - &loadfileForDisplay($step); - } + $loadingmode = &selectLoadingMode(); + if ($loadingmode eq 'replay') { + &loadfileForReplay($step); + } else { + &loadfileForDisplay($step); + } } else { - &loadfileForDisplay($step); + &loadfileForDisplay($step); } &hideProgressbar(); close(IN); } # end loadfile -#______ + sub stepsnumber { my $step = 0; @@ -2196,25 +2205,25 @@ sub loadfileForDisplay { my $step = shift; if ($messagesNumber > 0) { - my $diag = $mw->Dialog(-text => - "Some Ivy messages are already displayed. ". - "If you continue, loaded messages will ". - "be appended without distinction.\n", - -default_button => 'Continue', - -buttons => [qw(Continue Cancel)]); - my $answer = $diag->Show; - if ($answer eq 'Cancel') { - return; - } + my $diag = $mw->Dialog(-text => + "Some Ivy messages are already displayed. ". + "If you continue, loaded messages will ". + "be appended without distinction.\n", + -default_button => 'Continue', + -buttons => [qw(Continue Cancel)]); + my $answer = $diag->Show; + if ($answer eq 'Cancel') { + return; + } } # set load flags... $loadedFileFlag = 1; $loadingFlag = 1; $balloonhelp->attach($messagesMaxLabel, -balloonmsg => - "No history limit when file is loaded"); + "No history limit when file is loaded"); $balloonhelp->attach($messagesDeletedLabel, -balloonmsg => - "Messages deletion is deactivated when file is loaded"); + "Messages deletion is deactivated when file is loaded"); $messagesDeletedLabel->configure(-foreground => 'gray60'); $messagesDeletedValue->configure(-foreground => 'gray60'); @@ -2236,33 +2245,33 @@ sub loadfileForDisplay { $noUpdateFlag = 1; &beforeUpdatingMessages; while(<IN>) { - chomp; - if (/^applications=/ or /^messages_number=/) { - next; - } elsif (/^\s*$/) { - next; - $line++; - } elsif (/^(marker\d+)$/) { - my $index = $messagesText->index('current linestart'); - &addmarker($index, $1); - } else { - my ($sender, $message) = split(/ /, $_, 2); - my $time = undef; - if ($message =~ /^(\d+)\s+(.*)/) { - $time = $1; - $message = $2; - } - unless ($client{$sender}) { - $client{$sender} = 1; - $clientsListbox->insert('end', $sender); - } - $messagesNumber++; - $line++; - #$message =~ s/^\"(.*)\"$/$1/; - &loadMessage($sender, $message, $time); - #print "sender=$sender message=$message step=$step line=$line\n"; - &setProgressbar($line, $step); - } + chomp; + if (/^applications=/ or /^messages_number=/) { + next; + } elsif (/^\s*$/) { + next; + $line++; + } elsif (/^(marker\d+)$/) { + my $index = $messagesText->index('current linestart'); + &addmarker($index, $1); + } else { + my ($sender, $message) = split(/ /, $_, 2); + my $time = undef; + if ($message =~ /^(\d+)\s+(.*)/) { + $time = $1; + $message = $2; + } + unless ($client{$sender}) { + $client{$sender} = 1; + $clientsListbox->insert('end', $sender); + } + $messagesNumber++; + $line++; + #$message =~ s/^\"(.*)\"$/$1/; + &loadMessage($sender, $message, $time); + #print "sender=$sender message=$message step=$step line=$line\n"; + &setProgressbar($line, $step); + } } &afterUpdatingMessages; $noUpdateFlag = 0; @@ -2292,13 +2301,13 @@ sub loadfileForReplay { $replay_tpl->title("Replay mode"); my $ctrl_fm = $replay_tpl->Frame()->pack(-side => 'bottom', -pady => 5); $replay_text = $replay_tpl->Scrolled('Text', - -scrollbars => 'e', - -spacing1 => 2, - -spacing2 => 0, - -spacing3 => 2, - )->pack(-fill => 'both', - -expand => 1, - -side => 'bottom'); + -scrollbars => 'e', + -spacing1 => 2, + -spacing2 => 0, + -spacing3 => 2, + )->pack(-fill => 'both', + -expand => 1, + -side => 'bottom'); # colors $replay_bg_orig = $replay_text->cget(-background); $replay_fg_orig = $replay_text->cget(-foreground); @@ -2307,101 +2316,101 @@ sub loadfileForReplay { my $realspeedrate = 1; my $ctrl_fm1 = $ctrl_fm->Frame()->pack(-side => 'left', -padx => 10); $ctrl_fm1->Radiobutton(-text => "x0.1", -indicatoron => 0, - -height => 2, - -width => 4, - -value => 0.1, - -variable => \$replay_speed, - -command => sub { $realspeedrate = 0 }, - -selectcolor => 'white')->pack(-side => 'left'); + -height => 2, + -width => 4, + -value => 0.1, + -variable => \$replay_speed, + -command => sub { $realspeedrate = 0 }, + -selectcolor => 'white')->pack(-side => 'left'); $ctrl_fm1->Radiobutton(-text => "x0.5", -indicatoron => 0, - -height => 2, - -width => 4, - -value => 0.5, - -variable => \$replay_speed, - -command => sub { $realspeedrate = 0 }, - -selectcolor => 'white')->pack(-side => 'left'); + -height => 2, + -width => 4, + -value => 0.5, + -variable => \$replay_speed, + -command => sub { $realspeedrate = 0 }, + -selectcolor => 'white')->pack(-side => 'left'); $ctrl_fm1->Radiobutton(-text => "x1", -indicatoron => 0, - -height => 2, - -width => 4, - -value => 1, - -variable => \$replay_speed, - -command => sub { - return if $realspeedrate == 1; - $realspeedrate = 1; - $replay_data_t0 = $replay_time; - $replay_current_t0 = gettimeofday(); - if ($replay_running == 0) { - $replay_pause_t = $replay_current_t0; - } else { - $replay_pause_t = undef; - } - $replay_pause_duration = 0; - }, - -selectcolor => 'white')->pack(-side => 'left'); + -height => 2, + -width => 4, + -value => 1, + -variable => \$replay_speed, + -command => sub { + return if $realspeedrate == 1; + $realspeedrate = 1; + $replay_data_t0 = $replay_time; + $replay_current_t0 = gettimeofday(); + if ($replay_running == 0) { + $replay_pause_t = $replay_current_t0; + } else { + $replay_pause_t = undef; + } + $replay_pause_duration = 0; + }, + -selectcolor => 'white')->pack(-side => 'left'); $ctrl_fm1->Radiobutton(-text => "x2", -indicatoron => 0, - -height => 2, - -width => 4, - -value => 2, - -variable => \$replay_speed, - -command => sub { $realspeedrate = 0 }, - -selectcolor => 'white')->pack(-side => 'left'); + -height => 2, + -width => 4, + -value => 2, + -variable => \$replay_speed, + -command => sub { $realspeedrate = 0 }, + -selectcolor => 'white')->pack(-side => 'left'); $ctrl_fm1->Radiobutton(-text => "x5", -indicatoron => 0, - -height => 2, - -width => 4, - -value => 5, - -variable => \$replay_speed, - -command => sub { $realspeedrate = 0 }, - -selectcolor => 'white')->pack(-side => 'left'); + -height => 2, + -width => 4, + -value => 5, + -variable => \$replay_speed, + -command => sub { $realspeedrate = 0 }, + -selectcolor => 'white')->pack(-side => 'left'); $ctrl_fm1->Radiobutton(-text => "x10", -indicatoron => 0, - -height => 2, - -width => 4, - -value => 10, - -variable => \$replay_speed, - -command => sub { $realspeedrate = 0 }, - -selectcolor => 'white')->pack(-side => 'left'); + -height => 2, + -width => 4, + -value => 10, + -variable => \$replay_speed, + -command => sub { $realspeedrate = 0 }, + -selectcolor => 'white')->pack(-side => 'left'); # build hour label my $ctrl_fm2 = $ctrl_fm->Frame()->pack(-side => 'left', -padx => 10); my $hour_lab = $ctrl_fm2->Label(-borderwidth => 1, -relief => 'ridge', - -height => 2, - -width => ($replay_time_decimalplaces > 0) ? - 10 + $replay_time_decimalplaces : 9, - -textvariable => \$replay_hour, - )->pack(-side => 'left'); + -height => 2, + -width => ($replay_time_decimalplaces > 0) ? + 10 + $replay_time_decimalplaces : 9, + -textvariable => \$replay_hour, + )->pack(-side => 'left'); # build control buttons my $ctrl_fm3 = $ctrl_fm->Frame()->pack(-side => 'left', -padx => 10); $ctrl_fm3->Radiobutton(-text => "Play", -indicatoron => 0, - -width => 6, - -height => 2, - -value => 0, - -command => \&replayStart, - -variable => \$replay_runnable, - -selectcolor => 'white')->pack(-side => 'left'); + -width => 6, + -height => 2, + -value => 0, + -command => \&replayStart, + -variable => \$replay_runnable, + -selectcolor => 'white')->pack(-side => 'left'); $ctrl_fm3->Radiobutton(-text => "Pause", -indicatoron => 0, - -width => 6, - -height => 2, - -value => 1, - -command => \&replayStop, - -variable => \$replay_runnable, - -selectcolor => 'white')->pack(-side => 'left'); + -width => 6, + -height => 2, + -value => 1, + -command => \&replayStop, + -variable => \$replay_runnable, + -selectcolor => 'white')->pack(-side => 'left'); # build loop and step by step checkbuttons my $ctrl_fm4 = $ctrl_fm->Frame(-relief => 'ridge', -borderwidth => 1 - )->pack(-side => 'left', -padx => 10, -fill => 'y', - -expand => 1); + )->pack(-side => 'left', -padx => 10, -fill => 'y', + -expand => 1); $ctrl_fm4->Checkbutton(-text => "Repeat", - -variable => \$replay_repeat, - )->pack(-side => 'left'); + -variable => \$replay_repeat, + )->pack(-side => 'left'); $ctrl_fm4->Checkbutton(-text => "Step by\nstep", - -variable => \$replay_stepbystep, - -command => \&replayStop, - )->pack(-side => 'left', -padx => 10); + -variable => \$replay_stepbystep, + -command => \&replayStop, + )->pack(-side => 'left', -padx => 10); # build close button $ctrl_fm->Button(-text => "Close", - -command => \&replayClose, - -height => 1)->pack(-side => 'left', -padx => 10, -fill => 'y', - -expand => 1); + -command => \&replayClose, + -height => 1)->pack(-side => 'left', -padx => 10, -fill => 'y', + -expand => 1); $replay_tpl->update; $replay_tpl->minsize($replay_tpl->width, $replay_tpl->height); @@ -2409,52 +2418,52 @@ sub loadfileForReplay { # display messsages to replay my ($sender, $time, $message); while(<IN>) { - chomp; - next if /^\#/ or /^applications=/ or /^messages_number=/ - or /^\s*$/ or /^(marker\d+)$/; - ($sender, $time, $message) = split(/\s+/, $_, 3); - if ($replay_time_granularity >= 1) { - $time = int($time); - } else { - $time = sprintf("%.".$replay_time_decimalplaces."f", $time); - } - if (defined $replay_max_time) { - $replay_max_time = $time if $time > $replay_max_time; - } else { - $replay_max_time = $time; - } - if (defined $replay_min_time) { - $replay_min_time = $time if $time < $replay_min_time; - } else { - $replay_min_time = $time; - } - $line++; - $message =~ s/^\"//; - $message =~ s/\"$//; - push(@{$replay_msg{$time}}, $message); - $replay_text->insert('end', &replayTime($time)." ".$message."\n", $time); - # when user click on a message, the begin time changes. - $replay_text->tagBind($time, '<1>', [sub { - my $ti = $_[1]; - my $replay_was_running; - if ($replay_running) { - $replay_was_running = 1; - &replayStop; - } - my $fg = $replay_text->tagCget($ti, -foreground); - my $bg = $replay_text->tagCget($ti, -background); - $replay_text->tagConfigure($_[1], -foreground => 'white', - -background => 'gray50'); - $replay_hour = &replayTime($ti); - $replay_time = $ti; - $replay_text->after(100, [sub { - $replay_text->tagConfigure($_[0], - -foreground => $fg, - -background => $bg); - }, $ti]); - &replayStart if $replay_was_running; - }, $time]); - &setProgressbar($line, $step); + chomp; + next if /^\#/ or /^applications=/ or /^messages_number=/ + or /^\s*$/ or /^(marker\d+)$/; + ($sender, $time, $message) = split(/\s+/, $_, 3); + if ($replay_time_granularity >= 1) { + $time = int($time); + } else { + $time = sprintf("%.".$replay_time_decimalplaces."f", $time); + } + if (defined $replay_max_time) { + $replay_max_time = $time if $time > $replay_max_time; + } else { + $replay_max_time = $time; + } + if (defined $replay_min_time) { + $replay_min_time = $time if $time < $replay_min_time; + } else { + $replay_min_time = $time; + } + $line++; + $message =~ s/^\"//; + $message =~ s/\"$//; + push(@{$replay_msg{$time}}, $message); + $replay_text->insert('end', &replayTime($time)." ".$message."\n", $time); + # when user click on a message, the begin time changes. + $replay_text->tagBind($time, '<1>', [sub { + my $ti = $_[1]; + my $replay_was_running; + if ($replay_running) { + $replay_was_running = 1; + &replayStop; + } + my $fg = $replay_text->tagCget($ti, -foreground); + my $bg = $replay_text->tagCget($ti, -background); + $replay_text->tagConfigure($_[1], -foreground => 'white', + -background => 'gray50'); + $replay_hour = &replayTime($ti); + $replay_time = $ti; + $replay_text->after(100, [sub { + $replay_text->tagConfigure($_[0], + -foreground => $fg, + -background => $bg); + }, $ti]); + &replayStart if $replay_was_running; + }, $time]); + &setProgressbar($line, $step); } $replay_tpl->raise; $replay_time = $replay_min_time; @@ -2465,9 +2474,9 @@ sub loadfileForReplay { # baloon help $balloonhelp->attach($replay_text, -balloonmsg => - "Select an item in the list to\n". - "modify the begin time of replay" - ); + "Select an item in the list to\n". + "modify the begin time of replay" + ); } # end loadfileForReplay @@ -2475,16 +2484,16 @@ sub loadfileForReplay { sub selectLoadingMode { my $diag = $mw->Dialog(-text => - "The selected file contains time informations. ". - "Do you want to replay the recorded messages or ". - "just display them?", - -default_button => 'Just display', - -buttons => ['Replay', 'Just display']); + "The selected file contains time informations. ". + "Do you want to replay the recorded messages or ". + "just display them?", + -default_button => 'Just display', + -buttons => ['Replay', 'Just display']); my $answer = $diag->Show; if ($answer eq 'Replay') { - return 'replay'; + return 'replay'; } else { - return 'display'; + return 'display'; } } # end selectLoadingMode @@ -2495,11 +2504,11 @@ sub savefile { $y =~ s/^\d// if $y >= 100; $m++; my $default = (defined $outputfile) ? $outputfile : - sprintf("ivylog%02s%02s%02s_%02s:%02s.ivy", $d, $m, $y, $h, $M); + sprintf("ivylog%02s%02s%02s_%02s:%02s.ivy", $d, $m, $y, $h, $M); my $file = $mw->getSaveFile(-initialfile => $default, - -filetypes => [['Ivy Files', '.ivy'], - ['All Files', '*']], - ); + -filetypes => [['Ivy Files', '.ivy'], + ['All Files', '*']], + ); return unless $file; $outputfile = $file; &showProgressbar(); @@ -2516,21 +2525,21 @@ sub savefile { $mw->update; my $restorestate = sub { - &hideProgressbar(); - # restore other buttons state - $loadButton->configure(-state => 'normal'); - $saveButton->configure(-state => 'normal'); - $jumpButton->configure(-state => $jumpstate); - $clearButton->configure(-state => 'normal'); - $startButton->configure(-state => $startstate); - $stopButton->configure(-state => $stopstate); + &hideProgressbar(); + # restore other buttons state + $loadButton->configure(-state => 'normal'); + $saveButton->configure(-state => 'normal'); + $jumpButton->configure(-state => $jumpstate); + $clearButton->configure(-state => 'normal'); + $startButton->configure(-state => $startstate); + $stopButton->configure(-state => $stopstate); }; my $status = 0; if (&save < 0) { - $mw->Tk::Error("$!\n"); - &$restorestate; - return; + $mw->Tk::Error("$!\n"); + &$restorestate; + return; } close(OUT); &$restorestate; @@ -2544,22 +2553,22 @@ sub openfile { $file = $opt_out unless defined $file; return 0 unless defined $file; if (open(OUT, ">$file")) { - return 1; + return 1; } else { - close(OUT); - $mw->Tk::messageBox(-icon => "warning", - -message => - "Can't write to file $file ($!). ". - "Save data in ivymon-rescue.ivy", - -type => 'OK', - ); - if (open(OUT, ">ivymon-rescue.ivy")) { - return 1; - } else { - close(OUT); - $mw->Tk::Error("Can't write to output file ($!)"); - return -1; - } + close(OUT); + $mw->Tk::messageBox(-icon => "warning", + -message => + "Can't write to file $file ($!). ". + "Save data in ivymon-rescue.ivy", + -type => 'OK', + ); + if (open(OUT, ">ivymon-rescue.ivy")) { + return 1; + } else { + close(OUT); + $mw->Tk::Error("Can't write to output file ($!)"); + return -1; + } } } # sub openfile @@ -2590,17 +2599,17 @@ sub save { my $index = "1.0"; my $counter = 0; while(1) { - my $messages = $messagesText->get($index, "$index + 100 lines"); - $index = "$index + 100 lines"; - unless ($messages) { - &setProgressbar($nblines); - $progressbar->update; - last; - } - print OUT $messages or return -1; - &setProgressbar($counter); - $counter += 100; - $progressbar->update if ($step == 0 or $counter % $step == 0); + my $messages = $messagesText->get($index, "$index + 100 lines"); + $index = "$index + 100 lines"; + unless ($messages) { + &setProgressbar($nblines); + $progressbar->update; + last; + } + print OUT $messages or return -1; + &setProgressbar($counter); + $counter += 100; + $progressbar->update if ($step == 0 or $counter % $step == 0); } &setProgressbar(0); $mw->after(300, sub {$tpl->destroy;}); @@ -2707,19 +2716,22 @@ sub replayStart { # if speed rate != 1, time regulation is deactivated if ($replay_speed != 1) { $replay_current_factor = $replay_factor; - print "replay_speed=$replay_speed => time regulation deactivated\n" if $opt_debug; + print "replay_speed=$replay_speed => time regulation deactivated\n" + if $opt_debug; # if replay is running behind schedule - } elsif ($dt > $data_dt + $replay_maxgap and $replay_current_factor <= $replay_factor) { + } elsif ($dt > $data_dt + $replay_maxgap and + $replay_current_factor <= $replay_factor) { $replay_current_factor *= (1 - $replay_regulpct->[0]/100); - print "data_dt=$data_dt dt=$dt2 delay=$d [--] replay_factor=$replay_current_factor\n" - if $opt_debug; + print "data_dt=$data_dt dt=$dt2 delay=$d [--] ". + "replay_factor=$replay_current_factor\n" if $opt_debug; # if replay is getting ahead of schedule - } elsif ($dt < $data_dt - $replay_maxgap and $replay_current_factor >= $replay_factor) { + } elsif ($dt < $data_dt - $replay_maxgap and + $replay_current_factor >= $replay_factor) { $replay_current_factor *= (1 + $replay_regulpct->[1]/100); - print "data_dt=$data_dt dt=$dt2 delay=$d [++] replay_factor=$replay_current_factor\n" - if $opt_debug; + print "data_dt=$data_dt dt=$dt2 delay=$d [++] ". + "replay_factor=$replay_current_factor\n" if $opt_debug; # if replay is on time } else { @@ -2760,18 +2772,18 @@ sub replayTime { my $time = shift; if (defined $time) { - my ($s, $m, $h) = localtime($time); - if ($replay_time_decimalplaces > 0) { - my $dec = - substr($time, -$replay_time_decimalplaces, $replay_time_decimalplaces); - return sprintf("%02d:%02d:%02d.%s", $h, $m, $s, $dec); - } else { - return sprintf("%02d:%02d:%02d", $h, $m, $s); - } + my ($s, $m, $h) = localtime($time); + if ($replay_time_decimalplaces > 0) { + my $dec = + substr($time, -$replay_time_decimalplaces, $replay_time_decimalplaces); + return sprintf("%02d:%02d:%02d.%s", $h, $m, $s, $dec); + } else { + return sprintf("%02d:%02d:%02d", $h, $m, $s); + } } elsif ($replay_time_decimalplaces > 0) { - return "--:--:--."."-" x $replay_time_decimalplaces; + return "--:--:--."."-" x $replay_time_decimalplaces; } else { - return "--:--:--"; + return "--:--:--"; } } # end replayTime @@ -2828,79 +2840,79 @@ sub findExprInList { my @elems = $list->get(0, "end"); # if key is Tab if ($key eq 'Tab') { - my $index = 0; - my @found; - my $elem; - my $qmexpr = quotemeta($expr); - for $elem (sort @elems) { - #print "qmexpr=$qmexpr qmelem=",quotemeta($elem),"\n"; - if ($expr and $elem =~ /^$qmexpr/) { - push (@found, $index); - } - $index++; - } - # no expression found - if (@found == 0) { - &warning2($entry); - my @cursel = $list->curselection; - $list->selectionClear(@cursel) if @cursel > 0; - &findRvalue($entry, $expr); - # only one expression is found - } elsif (@found == 1) { - my @cursel = $list->curselection; - $list->selectionClear(@cursel) if @cursel > 0; - $list->selectionSet($found[0]); - $list->see($found[0]); - my $listexpr = $list->get($found[0]); - if ($listexpr ne $expr) { - $entry->delete(0, 'end'); - $entry->insert(0, scalar $list->get($found[0])); - } - &findRvalue($entry, $expr); - - # several expressions are found - } else { - &warning1($entry); - my $i = 0; - my $str = $list->get($found[0]); - my $commonstr; - for ($i=0; $i < length($str); $i++) { - my $char = substr($str, length($expr)+$i, 1); - my $j = 0; - while ($j < @found) { - last if substr(scalar $list->get($found[$j]), length($expr)+$i, 1) - ne $char; - $j++; - } - if ($j == @found) { - $commonstr = $commonstr.$char; - } else { - last; - } - } - $entry->insert('end', $commonstr); - } - - # if entry is empty and if key is not Tab (key is backspace) + my $index = 0; + my @found; + my $elem; + my $qmexpr = quotemeta($expr); + for $elem (sort @elems) { + #print "qmexpr=$qmexpr qmelem=",quotemeta($elem),"\n"; + if ($expr and $elem =~ /^$qmexpr/) { + push (@found, $index); + } + $index++; + } + # no expression found + if (@found == 0) { + &warning2($entry); + my @cursel = $list->curselection; + $list->selectionClear(@cursel) if @cursel > 0; + &findRvalue($entry, $expr); + # only one expression is found + } elsif (@found == 1) { + my @cursel = $list->curselection; + $list->selectionClear(@cursel) if @cursel > 0; + $list->selectionSet($found[0]); + $list->see($found[0]); + my $listexpr = $list->get($found[0]); + if ($listexpr ne $expr) { + $entry->delete(0, 'end'); + $entry->insert(0, scalar $list->get($found[0])); + } + &findRvalue($entry, $expr); + + # several expressions are found + } else { + &warning1($entry); + my $i = 0; + my $str = $list->get($found[0]); + my $commonstr; + for ($i=0; $i < length($str); $i++) { + my $char = substr($str, length($expr)+$i, 1); + my $j = 0; + while ($j < @found) { + last if substr(scalar $list->get($found[$j]), length($expr)+$i, 1) + ne $char; + $j++; + } + if ($j == @found) { + $commonstr = $commonstr.$char; + } else { + last; + } + } + $entry->insert('end', $commonstr); + } + + # if entry is empty and if key is not Tab (key is backspace) } elsif (not $expr) { - my @cursel = $list->curselection; - $list->selectionClear(@cursel) if @cursel > 0; - - # if entry is not empty and key is not Tab + my @cursel = $list->curselection; + $list->selectionClear(@cursel) if @cursel > 0; + + # if entry is not empty and key is not Tab } else { - my $index = 0; - for my $elem (sort @elems) { - my $qwexpr = quotemeta($expr); - if ($expr and $elem =~ /^$qwexpr/) { - my @cursel = $list->curselection; - $list->selectionClear(@cursel) if @cursel > 0; - $list->selectionSet($index); - $list->see($index); - #print "$elem\n"; - last; - } - $index++; - } + my $index = 0; + for my $elem (sort @elems) { + my $qwexpr = quotemeta($expr); + if ($expr and $elem =~ /^$qwexpr/) { + my @cursel = $list->curselection; + $list->selectionClear(@cursel) if @cursel > 0; + $list->selectionSet($index); + $list->see($index); + #print "$elem\n"; + last; + } + $index++; + } } } # end findExprInList @@ -2912,17 +2924,17 @@ sub findRvalue { my $cursorIndex = $entry->index('insert'); my $index = index($expr, '=', $cursorIndex); if ($index < 0) { - $index = index($expr, '='); + $index = index($expr, '='); } return if $index < 0; my $rvalue = substr($expr, $index+1); $entry->selectionClear; if ($rvalue =~ /(^\S+)/) { - $rvalue = $1; - # skip char ) at the end of string - $rvalue =~ s/\)$//; - $entry->selectionFrom($index+1); - $entry->selectionTo($index +1 + length($rvalue)); + $rvalue = $1; + # skip char ) at the end of string + $rvalue =~ s/\)$//; + $entry->selectionFrom($index+1); + $entry->selectionTo($index +1 + length($rvalue)); } $entry->icursor($index+1); $entry->xview($index-15); |