summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rwxr-xr-xsrc/ivymon472
1 files changed, 300 insertions, 172 deletions
diff --git a/src/ivymon b/src/ivymon
index de0865f..e9107c4 100755
--- a/src/ivymon
+++ b/src/ivymon
@@ -8,12 +8,13 @@ use Tk::FBox;
use Tk::ErrorDialog;
use Tk::Dialog;
use Tk::ProgressBar;
+use Sys::Hostname;
use Ivy;
use Carp;
use strict 'vars';
use Getopt::Long;
use Tk::CmdLine;
-use vars qw/$opt_help $opt_b $opt_history @opt_bind @opt_send/;
+use vars qw/$opt_help $opt_b $opt_history @opt_bind @opt_send $opt_msgsfile/;
# geometry
my $minW = 1050;
@@ -24,7 +25,10 @@ my $history = 200000;
my $casesensitiveflag = 1;
my $regexpflag = 0;
# misc
+my $hostname = hostname();
my %connectedClients;
+my %clientsBindings;
+my %clientBindingsTpl;
my %bindings;
my %effectivebindings;
my %bindingsIndex;
@@ -47,6 +51,7 @@ my %bindHistory;
my @bindHistory;
my $bindHistoryIndex = -1;
+my $clockbackwardflag = 0;
my @messagesbuffer;
my $markers_cnt = 0;
@@ -93,8 +98,13 @@ my @send_def =
'GetStrip MsgName= Flight= Sector=',
'GetRange MsgName= Flight=',
'GetDuplicate MsgName= Flight=',
+ 'GetTrack MsgName= Flight=',
'GetDataBaseInfos MsgName= Cond=',
'GetFlightsWithStrip MsgName= Sector=',
+ 'GetSidStarNames MsgName=',
+ 'GetStandardTrajectory MsgName= Type= Name=',
+ 'GetGroupsOfSectors MsgName=',
+ 'SetGroupsOfSectors List=',
'SetStripTime Flight= Sector= Time=',
'SetSectorIn Flight= Sector= Time=',
'SetSectorOut Flight= Sector= Time=',
@@ -110,6 +120,9 @@ my @send_def =
'AircraftHeading Flight= To=',
'AircraftTurn Flight= Angle=',
'AircraftLevel Flight= Fl=',
+ 'AircraftSpeed Flight= Speed=',
+ 'AircraftIntercept Flight= Beacon= Axis=',
+ 'AircraftSetTrack Flight= Slice=',
'SetUserEventList Flight= EventName= List=',
'MergeUserEventList Flight= EventName= List=',
'GetUserEventList Flight= Name=',
@@ -128,93 +141,53 @@ my @send_def =
'FileWrite Type=rejeu Name=',
'FileWrite Type=simu Name=',
'FileWrite Type=dump Name=',
- 'SelectionEvent acc= wp= role= Flight=',
- 'SelectionEvent acc= wp= Flight=',
- 'DeselectionEvent acc= wp= role= Flight=',
- 'DeselectionEvent acc= wp= Flight=',
- 'ClosedClearanceEditor Acc= Wp= Role= Flight=',
- 'ClosedClearanceEditor Acc= Wp= Flight=',
- 'OpenClearanceEditor Acc= Wp= Role= Flight=',
- 'OpenClearanceEditor Acc= Wp= Flight=',
+ 'ClockEvent Time= Rate= Bs=',
+ 'RadarEndEvent',
+ 'TrackMovedEvent Flight= CallSign= Ssr= Sector= Layers= Y= Vx= Vy= Afl= '.
+ 'Rate= Heading= GroundSpeed= Tendency= Time=',
+ 'TrackDiedEvent Flight=',
'SectorEvent Flight= SectorOut= SectorIn= Time=',
- );
+ 'BeaconEvent Flight= Beacon= Fl= Mode= Time=',
+ 'LayerEvent Flight= Layer= Mode=',
+ 'StripEvent Flight= Time= CallSign= AircraftType= Ssr= Speed= Rfl= Sector= '.
+ 'ExitSector= Frequency= Efl= Tfl= List=',
+ 'PlnEvent Flight= Time= CallSign= AircraftType= Ssr= Speed= Rfl= Dep= Arr= List=',
+ 'StcaAlertEvent Flight= Mode= MinValidLevel= MaxValidLevel= OtherFlight= Time=',
+ 'MsawAlertEvent Flight= Type= Time=',
+ 'UserEvent Flight= Name= Value=',
+ 'RadarRefresh Period=',
+ 'Trajectory XXX Slice=',
+ 'Trajectory XXX EndSlice',
+ 'Pln XXX Flight= Time= CallSign= AircraftType= Ssr= Speed= Rfl= Dep= Arr= List=',
+ 'SectorsInfos XXX Flight=123 List=',
+ 'Position XXX Flight= CallSign= Ssr= Sector= Layers= X= Y= Vx= Vy= Afl= '.
+ 'Rate= Heading= GroundSpeed= Tendency= Time=',
+ 'OldPositions XXX Flight= Nb= List=',
+ 'Strip XXX Flight= Time= CallSign= AircraftType= Ssr= Speed= Rfl= Dep= '.
+ 'Arr= Sector= ExitSector= Frequency= Efl= Tfl= List=',
+ 'Range XXX FirstTime= LastTime= Visible=',
+ 'Duplicate XXX NewFlight=',
+ 'Track XXX Slice=',
+ 'Track XXX EndSlice',
+ 'DataBaseInfos XXX Nb= List=',
+ 'FlightsWithStrip XXX Sector= List=',
+ 'SidStarNames XXX sid= star=',
+ 'StandardTrajectory XXX Slice=',
+ 'StandardTrajectory XXX EndSlice',
+ 'GroupsOfSectors XXX List=',
+ 'FileReadEvent Type=REJEU Name= StartTime= EndTime=',
+ 'FileReadEvent Type=SIMU Name= StartTime= EndTime=',
+ 'TrajectoryUpdateEvent Flight=',
+ );
# Rejeu available (not effective) bindings array
-my @bind_def = ('(.*)',
- '(^ClockEvent .*)',
- '(^RadarEndEvent)',
- '(^TrackMovedEvent .*)',
- '(^TrackDiedEvent .*)',
- '(^SectorEvent .*)',
- '(^BeaconEvent .*)',
- '(^LayerEvent .*)',
- '(^StripEvent .*)',
- '(^PlnEvent .*)',
- '(^StcaAlertEvent .*)',
- '(^MsawAlertEvent .*)',
- '(^ClockStop)',
- '(^ClockStart)',
- '(^ClockBackward)',
- '(^ClockForward)',
- '(^SetClock .*)',
- '(^GetClockDatas)',
- '(^ClockDatas .*)',
- '(^GetRadarRefresh)',
- '(^RadarRefresh .*)',
- '(^GetTrajectory .*)',
- '(^Trajectory .*)',
- '(^GetPln .*)',
- '(^Pln .*)',
- '(^GetSectorsInfos .*)',
- '(^SectorsInfos .*)',
- '(^GetPosition .*)',
- '(^Position .*)',
- '(^GetOldPositions .*)',
- '(^OldPositions .*)',
- '(^GetStrip .*)',
- '(^Strip .*)',
- '(^GetRange .*)',
- '(^Range .*)',
- '(^GetDuplicate .*)',
- '(^Duplicate .*)',
- '(^GetDataBaseInfos .*)',
- '(^DataBaseInfos .*)',
- '(^GetFlightsWithStrip .*)',
- '(^FlightsWithStrip .*)',
- '(^SetStripTime .*)',
- '(^SetSectorIn .*)',
- '(^SetSectorOut .*)',
- '(^SetSectorsInfos .*)',
- '(^SetCallSign .*)',
- '(^SetMiniPln .*)',
- '(^SetTfl .*)',
- '(^SetBeforeTrack .*)',
- '(^SetAfterTrack .*)',
- '(^TranslateTime .*)',
- '(^TranslateFl .*)',
- '(^AircraftDirect .*)',
- '(^AircraftTurn .*)',
- '(^AircraftLevel .*)',
- '(^SetUserEventList .*)',
- '(^UserEvent .*)',
- '(^MergeUserEventList .*)',
- '(^SetUserEventList .*)',
- '(^MergeUserEventList .*)',
- '(^GetUserEventList .*)',
- '(^UserEventList .*)',
- '(^SetUserEventList .*)',
- '(^UserEventNames .*)',
- '(^CancelLastOrder .*)',
- '(^Discard .*)',
- '(^Enable .*)',
- '(^Dump .*)',
- '(^StripsOnOff .*)',
- '(^TagStrip .*)',
- '(^PrintTaggedStrips)',
- '(^Debug .*)',
- '(^FileRead .*)',
- '(^FileWrite .*)',
- );
+my @bind_def = (@send_def);
+for (@bind_def) {
+ s/\=\s+/\=\.\* /g;
+ s/\=\s*$/=\.\*/g;
+ s/^(.*)$/\(^$1\)/;
+
+}
# Effective bindings array
my @effectivebind;
@@ -227,10 +200,12 @@ my @effectivebind;
Tk::CmdLine::SetArguments(-font => '7x14');
Tk::CmdLine::SetArguments();
-if (not GetOptions('-help', '-history=s', '-b=s', '-bind=s@', '-send=s@') or $opt_help) {
+if (not GetOptions('-help', '-history=s', '-b=s', '-bind=s@',
+ '-send=s@', '-msgsfile=s') or $opt_help) {
print "Usage: ivymon [-b bus] [-help] [-history length]\n";
print " [-bind regexp1] ... [-bind regexpN] \n";
print " [-send message1] ... [-send messageN] \n";
+# print " [-msgsfile file]\n";
print " [standard X11 options...]\n";
print "\n";
print "Options :\n";
@@ -239,6 +214,7 @@ if (not GetOptions('-help', '-history=s', '-b=s', '-bind=s@', '-send=s@') or $op
"(default $history messages)\n";
print " -bind <regexp> Ivy binding regular expression\n";
print " -send <string> Ivy message to send\n";
+# print " -msgsfile <file> Ivy messages file\n";
print "\n";
exit ;
@@ -498,6 +474,7 @@ my $clientsListbox =
-expand => 1,
-side => 'top');
$clientsListbox->bind('<1>', [\&selectClient]);
+$clientsListbox->bind('<Double-1>', [\&showClientBindings]);
&wheelmousebindings($clientsListbox);
#----------------------------------------------------------------------------------
@@ -511,7 +488,28 @@ my $sendEntry =
-ipady => 3,
-expand => 0,
-pady => 5);
-
+my $send2_fm = $send_fm->Frame()->pack(-side => 'top',
+ -expand => 1,
+ -fill => 'both');
+my $clockstartButton =
+ $send2_fm->Button(-height => 1,
+ -command => [\&clockstart],
+ -text => "Clock Start")->grid(-column => 1,
+ -row => 1);
+my $clockstopButton =
+ $send2_fm->Button(-height => 1,
+ -command => [\&clockstop],
+ -text => "Clock Stop")->grid(-column => 2,
+ -row => 1);
+my $clockbackCheckbutton =
+ $send2_fm->Checkbutton(-selectcolor => undef,
+ -indicatoron => 0,
+ -command => [\&clockswitch],
+ -variable => \$clockbackwardflag,
+ -text => "Backward")->grid(-column => 3,
+ -row => 1,
+ -ipadx => 10,
+ -sticky => 'nsew');
my $sendList =
$send_fm->Scrolled(Listbox,
-scrollbars => 'e',
@@ -519,6 +517,7 @@ my $sendList =
-anchor => 'w',
-side => 'bottom',
-expand => 1);
+
$sendEntry->bind('<Key>' => [\&findExprInList, $sendList]);
$sendEntry->bind('<Return>' => [\&addMsgToSend, undef, 1]);
@@ -674,64 +673,74 @@ for my $msg (sort(@send_def)) {
#----------------------------------------------------------------------------------
$balloonhelp->attach($messagesMaxLabel, -balloonmsg =>
"Maximum number of recordable messages\n".
- "(=history size value)"
+ "(=history size value) "
);
$balloonhelp->attach($messagesDeletedLabel, -balloonmsg =>
"Counter for received messages which are\n".
- "skipped when history size is reached."
+ "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."
+ "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."
);
$balloonhelp->attach($bindingsEntry, -balloonmsg =>
"This input field is used to enter new bindings or\n".
- "edit default one from list above. In both case, hit\n".
- "[Enter] to apply. Provides completion and history\n".
- "functionalities : type part of a word and hit the\n".
- "[Tab] key to activate completion, use [Up] and\n".
- "[Down] keys to access previous inputs."
+ "edit default one from list above. In both case, \n".
+ "hit [Enter] to apply. \n".
+ "Provides completion and history functionalities :\n".
+ "type part of a word and hit the [Tab] key to \n".
+ "activate completion, use [Up] and [Down] keys to \n".
+ "access previous inputs. \n".
+ "Also makes values entries easier : when you hit \n".
+ "the [Tab] key, the insertion cursor move to the \n".
+ "next rvalue field. "
);
$balloonhelp->attach($bindingsList, -balloonmsg =>
- "Available bindings list. Select an item for edition\n".
- "or 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."
);
$balloonhelp->attach($clientsListbox,-balloonmsg =>
- "Select an application name to highlight\n".
- "related Ivy messages in the Messages area.");
+ "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. ");
$balloonhelp->attach($sendEntry, -balloonmsg =>
"This input field is used to enter new messages or\n".
- "edit default one from list above. In both case, hit\n".
- "[Enter] to send it. Provides completion and history\n".
- "functionalities : type part of a word and hit the\n".
- "[Tab] key to activate completion, use [Up] and\n".
- "[Down] keys to access previous inputs."
+ "edit default one from list above. In both case, \n".
+ "hit [Enter] to send it. \n".
+ "Provides completion and history functionalities :\n".
+ "type part of a word and hit the [Tab] key to \n".
+ "activate completion, use [Up] and [Down] keys to \n".
+ "access previous inputs. \n".
+ "Also makes values entries easier : when you hit \n".
+ "the [Tab] key, the insertion cursor move to the \n".
+ "next rvalue field. "
);
$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($messagesText, -balloonmsg =>
- "You can insert colored marker by double-clicking on a\n".
+ "You can insert colored marker by double-clicking on a \n".
"message application name (marker will be created after\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."
+ "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\n".
- "in messages list. Hit [Return] key to search\n".
- "forward and [Shift-Return] key to search backward.\n".
- "Provides history functionality : use [Up] and [Down]\n".
- "keys to access previous inputs."
+ "This input field is used to search expressions in\n".
+ "messages list. Hit [Return] key to search forward\n".
+ "and [Shift-Return] key to search backward. \n".
+ "Provides history functionality : use [Up] and \n".
+ "[Down] keys to access previous inputs. "
);
$balloonhelp->attach($stopButton, -balloonmsg =>
"Stop scrolling in Messages area."
@@ -744,38 +753,24 @@ $balloonhelp->attach($jumpButton, -balloonmsg =>
);
$balloonhelp->attach($clearButton, -balloonmsg =>
"Remove messages displayed\n".
- "in Messages area."
+ "in Messages area. "
);
$balloonhelp->attach($loadButton, -balloonmsg =>
"Load messages file and display\n".
- "its content in Messages area."
+ "its content in Messages area. "
);
$balloonhelp->attach($saveButton, -balloonmsg =>
"Save the content of Messages\n".
- "area in a file."
+ "area in a file. "
);
-# alarm on balloon help
-my $repeatid = $balloon_cb->repeat(200, sub {
- if ($balloon_cb->cget(-foreground) eq 'ivory') {
- $balloon_cb->configure(-foreground => 'black');
- } else {
- $balloon_cb->configure(-foreground => 'ivory');
- }
-});
-$balloon_cb->after(2000, sub {$balloon_cb->configure(-foreground => 'black');
- $balloon_cb->afterCancel($repeatid)
- });
-
-
#=================================================================================
#
# Ivy initialisation and Ivy bindings
#
#=================================================================================
# add Ivymon in connected applications list
-$connectedClients{$appname}++;
-&addClient($appname, 'localhost', 1);
+&addClient($appname, 'localhost');
# init Ivy bus and start it.
Ivy->init(-loopMode => 'TK',
@@ -833,62 +828,77 @@ sub removeIvyBinding {
sub checkClientsStatus {
my $appname = $_[3];
my $status = $_[4];
- my $host = $_[5];
- my $message;
+ my $host_or_regexp = $_[5];
$appname =~ s/ /_/g;
if ($status eq 'died') {
- $connectedClients{$appname}--;
+ &removeClient($appname, $host_or_regexp);
} elsif ($status eq 'new') {
- $connectedClients{$appname}++;
+ &addClient($appname, $host_or_regexp);
+ } elsif ($status eq 'subscribing') {
+ $clientsBindings{$appname}->{$host_or_regexp}++;
+ } elsif ($status eq 'unsubscribing') {
+ $clientsBindings{$appname}->{$host_or_regexp}--;
} else {
carp "In Ivymon, checkClientsStatus function, unknown status <$status>\n";
}
- if ($connectedClients{$appname} == 0) {
- &removeClient($appname, $host);
- } elsif ($connectedClients{$appname} >= 1) {
- &addClient($appname, $host, $connectedClients{$appname});
- } else {
- carp "In Ivymon, checkClientsStatus function, found negative ".
- "<$connectedClients{$appname}> instances of application <$appname>!!!\n";
- }
} # end checkClientsStatus
-
sub addClient {
my $client = shift;
my $host = shift;
- my $num = shift;
- my $i = 0;
- for ($clientsListbox->get(0, 'end')) {
- if ($_ eq "$client on $host" or $_ =~ /^$client\(\d+\)$/) {
- $clientsListbox->delete($i);
- }
- $i++;
- }
- if ($num == 1) {
- $clientsListbox->insert($i, "$client on $host");
- } else {
- $clientsListbox->insert($i, "$client($num)");
- }
-
+ $host = $hostname if $host eq 'localhost' or $host =~ /^$hostname\./;
+ #print "addClient $client on $host\n";
+ $connectedClients{$client}->{$host}++;
+ &manageClient($client, $host);
+
} # end addClient
sub removeClient {
my $client = shift;
my $host = shift;
+ $host = $hostname if $host eq 'localhost' or $host =~ /^$hostname\./;
+ $connectedClients{$client}->{$host}-- if $connectedClients{$client}->{$host} > 0;
+ &manageClient($client, $host);
+
+} # end removeClient
+
+
+sub manageClient {
+ my $client = shift;
+ my $host = shift;
my $i = 0;
for ($clientsListbox->get(0, 'end')) {
- if ($_ eq "$client on $host") {
+ if ($_ =~ /^$client/) {
$clientsListbox->delete($i);
last;
}
$i++;
}
-
-} # end removeClient
+ my $num = 0;
+ for (values(%{$connectedClients{$client}})) {
+ $num += $_;
+ }
+ if ($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
sub selectClient {
@@ -908,6 +918,46 @@ sub selectClient {
} # end selectClient
+
+
+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);
+ for my $regexp (sort keys(%{$clientsBindings{$client}})) {
+ $t->insert('end', $regexp."\n")
+ if $clientsBindings{$client}->{$regexp} > 0;
+ }
+ $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
+
+
#----------------------------------------------------------------------------------
# Functions related to messages display management
#----------------------------------------------------------------------------------
@@ -939,6 +989,7 @@ sub marker {
} # end marker
+
sub deletemarker {
my $marker = shift;
$messagesText->configure(-state => 'normal');
@@ -948,6 +999,7 @@ sub deletemarker {
} # end deletemarker
+
sub addmarker {
my $index = shift;
my $marker = shift;
@@ -961,6 +1013,7 @@ sub addmarker {
} # ens addmarker
+
sub bufferizeMessages {
my ($sender, $message) = @_;
$bufNumber++;
@@ -970,12 +1023,13 @@ sub bufferizeMessages {
} # end bufferizeMessages
+
sub beforeUpdatingMessages {
$messagesText->configure(-state => 'normal');
-
} # end beforeUpdatingMessages
+
sub updateMessages {
my ($sender, $message) = @_;
chomp($message);
@@ -1005,6 +1059,7 @@ sub updateMessages {
} # end updateMessages
+
sub loadMessage {
my ($sender, $message) = @_;
$recordedNumber++;
@@ -1028,6 +1083,7 @@ sub afterUpdatingMessages {
} # end afterUpdatingMessages
+
sub highlightString {
my ($i1, $i2) = @_;
$messagesText->tagConfigure('found',
@@ -1115,6 +1171,8 @@ sub addBinding {
&warning3($bindingsEntry);
&addIvyBinding($entry);
&bindingsGenList;
+ $clientsBindings{$appname}->{"$entry"}++;
+
} # end addBinding
@@ -1154,6 +1212,8 @@ sub removeBinding {
&removeIvyBinding($selected);
$effectivebindingsList->delete($selindex);
$effectivebindings{$selected} = undef;
+ $clientsBindings{$appname}->{"$selected"}--;
+
} # end removeBinding
@@ -1271,9 +1331,13 @@ sub selectMsgToSend {
my $selected = $sendList->get($selindex);
$sendEntry->delete(0, 'end');
$sendEntry->insert(0, $selected);
+ my $index = index($selected, '=');
+ return if $index < 0;
+ $sendEntry->icursor($index+1);
} # end selectMsgToSend
+
sub sendGenList {
my $i = 0;
my $found = 0;
@@ -1299,6 +1363,35 @@ sub sendHistoryGenList {
} # end sendHistoryGenList
+
+sub clockstart {
+
+ &sendMsg("ClockStart");
+
+} # end clockstart
+
+
+sub clockstop {
+
+ &sendMsg("ClockStop");
+
+} # end clockstop
+
+
+sub clockswitch {
+ if ($clockbackwardflag == 1) {
+ &sendMsg("ClockBackward");
+ $clockbackCheckbutton->configure(-foreground => 'maroon',
+ -activeforeground => 'maroon');
+ } else {
+ &sendMsg("ClockForward");
+ $clockbackCheckbutton->configure(-foreground => 'black',
+ -activeforeground => 'black');
+ }
+
+} # end clockswitch
+
+
#----------------------------------------------------------------------------------
# Functions related to search panel
#----------------------------------------------------------------------------------
@@ -1802,6 +1895,7 @@ sub findExprInList {
my $expr = $entry->get;
#print "expr=$expr\n";
my @elems = $list->get(0, "end");
+ # if key is Tab
if ($key eq 'Tab') {
my $index = 0;
my @found;
@@ -1814,17 +1908,26 @@ sub findExprInList {
}
$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]);
- $entry->delete(0, 'end');
- $entry->insert(0, scalar $list->get($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;
@@ -1847,9 +1950,12 @@ sub findExprInList {
$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
} else {
my $index = 0;
for my $elem (sort @elems) {
@@ -1869,11 +1975,34 @@ sub findExprInList {
} # end findExprInList
+sub findRvalue {
+ my $entry = shift;
+ my $expr = shift;
+ my $cursorIndex = $entry->index('insert');
+ my $index = index($expr, '=', $cursorIndex);
+ if ($index < 0) {
+ $index = index($expr, '=');
+ }
+ my $rvalue = substr($expr, $index+1);
+ $entry->selectionClear;
+ if ($rvalue =~ /(^\S+)/) {
+ $rvalue = $1;
+ $entry->selectionFrom($index+1);
+ $entry->selectionTo($index +1 + length($rvalue));
+ }
+ return if $index < 0;
+ $entry->icursor($index+1);
+ $entry->xview($index-15);
+
+
+} # end findRvalue
+
+
sub warning1 {
my $widget = shift;
$widget->configure(-background => 'gray90');
$widget->after(100, sub {$widget->configure(-background => $bgcolor); });
- $widget->bell;
+ #$widget->bell;
} # end warning1
@@ -1882,7 +2011,7 @@ sub warning2 {
my $widget = shift;
$widget->configure(-background => 'gray30');
$widget->after(100, sub {$widget->configure(-background => $bgcolor); });
- $widget->bell;
+ #$widget->bell;
} # end warning2
@@ -1894,7 +2023,6 @@ sub warning3 {
} # end warning3
-
__END__
=head1 NAME
@@ -1917,9 +2045,9 @@ The main area is the window labeled B<Messages> where are printed messages that
The B<Applications> area lists the connected applications names. When you select an item in the listbox, the messages sent by this application are highlighted.
-The B<Bindings> area is used to manage regular expressions to subscribe to ivy messages. It provides an input field to enter new regexp, a first listbox which contains an alphabetical list of available bindings, and a second listbox of effective bindings. To bind a new regular expression, double-click on the corresponding item in the first list or select one, edit it in the input field and then hit the I<Return> key to validate. To remove subscription, double-click on the corresponding item in the second listbox. Pressing the I<Escape> key inserts I<(.*)> string in entry field. Default bindings match Rejeu messages V2.20. This field provides completion and history functionalities.
+The B<Bindings> area is used to manage regular expressions to subscribe to ivy messages. It provides an input field to enter new regexp, a first listbox which contains an alphabetical list of available bindings, and a second listbox of effective bindings. To bind a new regular expression, double-click on the corresponding item in the first list or select one, edit it in the input field and then hit the I<Return> key to validate. To remove subscription, double-click on the corresponding item in the second listbox. Pressing the I<Escape> key inserts I<(.*)> string in entry field. Default bindings match Rejeu messages V2.40. This field provides completion and history functionalities.
-The B<Messages to send> area is used to manage a list of predefined messages ready to be sent. It provides an input field to enter new message or edit existing one, and a listbox which contains an alphabetical list of available messages. When you validate an input (by pressing the I<Return> key), the new message is added to the listbox and sent on ivy bus. To send predefined messages, simply I<double-click> on corresponding item in the listbox. Default messages match Rejeu messages V2.20. This field provides completion and history functionalities.
+The B<Messages to send> area is used to manage a list of predefined messages ready to be sent. It provides an input field to enter new message or edit existing one, and a listbox which contains an alphabetical list of available messages. When you validate an input (by pressing the I<Return> key), the new message is added to the listbox and sent on ivy bus. To send predefined messages, simply I<double-click> on corresponding item in the listbox. Default messages match Rejeu messages V2.40. This field provides completion and history functionalities, and assistance for entering values.
The B<Search> area provides an interface for searching pattern in messages window. It provides an input field to enter new pattern, and control buttons. To highlight all matches, press the I<All> button. To make incremental search, press the I<Next> button or the I<Return> key to proceed forward, and press the I<Previous> button or the I<Shift-Return> key to proceed backward. This field provides an history functionality.