add CTY-3304

[spider.git] / gtkconsole / gtkconsole

diff --git a/gtkconsole/gtkconsole b/gtkconsole/gtkconsole
index db12d1e003984c83fb91e81dbab050ac9ff0b9e5..d371f0c48d4478b034eb451f7c7a2d6b1414b7ae 100755 (executable)
--- a/gtkconsole/gtkconsole
+++ b/gtkconsole/gtkconsole
@@ -11,9 +11,6 @@
 
 use strict;
 
-our $VERSION = '$Revision$';
-$VERSION =~ s|[^\d\.]+||g;
-
 our $root;
 
 # search local then perl directories
@@ -56,8 +53,16 @@ our $wwvwin;                                 # wwv window handle
 our $wcywin;                                   # wcy window handle
 our $chatwin;                                  # chat window handle
 
+# wants
+our ($wantann, $wantdx, $wantwwv, $wantwcy, $wantchat) = (1, 1, 1, 1, 1);
+
 require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm";
 
+our ($version, $subversion, $build);
+require "$root/perl/Version.pm";
+
+our $VERSION = "$version.$subversion build $build";
+
 # read in the user data
 our $userfn = "$ENV{HOME}/.gtkconsole_data";
 our $user = read_user_data();
@@ -85,37 +90,34 @@ if (@ARGV) {
        $port = shift @ARGV if @ARGV;
 }
 
-unless ($call && $host) {
+unless ($call) {
+       $call = $main::myalias;
+}
+
+unless ($host) {
        my $node = $user->{clusters}->{$user->{node}};
 
        if ($node->{call} || $user->{call}) {
-               $call = $node->{call} || $user->{call} || $main::myalias;
-               $host = $node->{passwd};
                $host = $node->{host};
-               $port = $node->{port};
+               $port ||= $node->{port};
        }
-}
 
-unless ($call && $host) {
-       if (-e "$root/local/Listeners.pm") {
-               require  "$root/local/Listeners.pm";
-               $host = $main::listen->[0]->[0];
-               $port = $main::listen->[0]->[1];
-               $host ||= '127.0.0.1';
-               $host = "127.0.0.1" if $host eq '0.0.0.0';
-               $port ||= 7300;
+       unless ($host) {
+               if (-e "$root/local/Listeners.pm") {
+                       require  "$root/local/Listeners.pm";
+                       $host = $main::listen->[0]->[0];
+                       $port = $main::listen->[0]->[1];
+                       $host ||= '127.0.0.1';
+                       $host = "127.0.0.1" if !$host && ($host eq '0.0.0.0' || $host eq '::');
+                       $port ||= 7300;
+               }
        }
 }
 
-unless ($host) {
-       $host = $user->{clusters}->{$user->{node}}->{host};
-       $port = $user->{clusters}->{$user->{node}}->{port};
-}
-
 $call ||= '';
 $host ||= '';
 $port ||= '';
-die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host;
+die "You need a callsign ($call), a hostname($host) and a port($port) to proceed" unless $call && $host && $port;
 
 #
 # start of GTK stuff
@@ -123,7 +125,7 @@ die "You need a callsign ($call), a hostname($host) and a port($port) to proceed
 
 gtk_create_main_screen();
 
-$main->set_title("gtkconsole $VERSION - DXSpider Console - $call \@ $host:$port");
+$main->set_title("DXSpider gtkconsole $VERSION - $call \@ $host:$port");
 
 # connect and send stuff
 my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port);
@@ -416,6 +418,7 @@ sub write_user_data
                my $dd = new Data::Dumper([ $u ]);
                $dd->Indent(1);
                $dd->Quotekeys(0);
+               $dd->Terse(1);
                $fh->print($dd->Dumpxs);
                $fh->close;
                return 1;
@@ -428,6 +431,12 @@ sub def_menu_callback
 
 }
 
+sub set_win
+{
+       my $var = shift;
+       $$var = shift;
+}
+
 sub gtk_create_main_screen
 {
        $main = new Gtk2::Window('toplevel');
@@ -453,6 +462,31 @@ sub gtk_create_main_screen
                                                                                                        }
                                                                                  ],
                                                         },
+                                       _Screens => {
+                                                                item_type =>'<Branch>',
+                                                                children => [
+                                                                                         _Dx => {
+                                                                                                         item_type => '<CheckMenuItem>',
+                                                                                                         callback => sub { set_win(\$wantdx, $@)},
+                                                                                                        },
+                                                                                         _Announce => {
+                                                                                                                       item_type => '<CheckItem>',
+                                                                                                                       callback => sub { set_win(\$wantann, $@)},
+                                                                                                                  },
+                                                                                         _Chat => {
+                                                                                                               item_type => '<CheckItem>',
+                                                                                                               callback => sub { set_win(\$wantchat, $@)},
+                                                                                                          },
+                                                                                         _WWV => {
+                                                                                                          item_type => '<CheckItem>',
+                                                                                                          callback => sub { set_win(\$wantwwv, $@)},
+                                                                                                         },
+                                                                                         _WCY => {
+                                                                                                          item_type => '<CheckItem>',
+                                                                                                          callback => sub { set_win(\$wantwcy, $@)},
+                                                                                                         },
+                                                                                        ],
+                                                               },
 
                                        _Help => {
                                                          item_type => '<Branch>',