From: minima Date: Wed, 19 Jul 2006 23:51:19 +0000 (+0000) Subject: add some flesh to a gtk based console program X-Git-Tag: 1.53~35 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=ae313f260d904cd45b58e4d1e620a49aef1a42c9;p=spider.git add some flesh to a gtk based console program --- diff --git a/cmd/set/gtk.pl b/cmd/set/gtk.pl new file mode 100644 index 00000000..0aec78c5 --- /dev/null +++ b/cmd/set/gtk.pl @@ -0,0 +1,14 @@ +# +# set the gtk flag +# +# Copyright (c) 2006 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @out; +$self->gtk(1); +$self->enhanced(1); +push @out, $self->msg('gtks', $self->call); +return (1, @out); diff --git a/cmd/set/var.pl b/cmd/set/var.pl index b8d81d26..5352baf3 100644 --- a/cmd/set/var.pl +++ b/cmd/set/var.pl @@ -14,9 +14,9 @@ return (1, $self->msg('e9')) unless $line; my ($var, $rest) = split /=|\s+/, $line, 2; $rest =~ s/^=\s*//; -Log('DXCommand', $self->call . " set $var = $rest" ); +Log('DXCommand', $self->call . " set $var = " . dd($rest) ); eval "$var = $rest"; -return (1, $@ ? $@ : "Ok, $var = $rest" ); +return (1, $@ ? $@ : "Ok, $var = " . dd($rest) ); diff --git a/cmd/show/var.pl b/cmd/show/var.pl index f68577f8..f0149cce 100644 --- a/cmd/show/var.pl +++ b/cmd/show/var.pl @@ -20,11 +20,7 @@ foreach $f (@f) { my @in; push @in, (eval $f); if (@in) { - my $dd = Data::Dumper->new([ \@in ], [ "$f" ]); - $dd->Indent(1); - $dd->Quotekeys(0); - my $s = $dd->Dumpxs; - push @out, $s; + push @out, "$f = ". dd(\@in); Log('DXCommand', $self->call . " show/var $f"); } else { push @out, $@ ? $@ : $self->msg('e3', 'show/var', $f); diff --git a/cmd/unset/gtk.pl b/cmd/unset/gtk.pl new file mode 100644 index 00000000..90b6cba7 --- /dev/null +++ b/cmd/unset/gtk.pl @@ -0,0 +1,14 @@ +# +# unset the gtk flag +# +# Copyright (c) 2006 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @out; +$self->gtk(0); +$self->enhanced(0); +push @out, $self->msg('gtku', $self->call); +return (1, @out); diff --git a/gtkconsole/gtkconsole b/gtkconsole/gtkconsole index 3b65d0e6..4b3a34ed 100755 --- a/gtkconsole/gtkconsole +++ b/gtkconsole/gtkconsole @@ -20,15 +20,16 @@ BEGIN { use strict; -use Gtk qw(-init); +use Glib; +use Gtk2 qw(-init); +use Gtk2::Helper; +use Gtk2::SimpleList; use vars qw(@modules $font); @modules = (); # is the list of modules that need init calling # on them. It is set up by each 'use'ed module # that has Gtk stuff in it -$font = Gtk::Gdk::Font->load("-misc-fixed-medium-r-normal-*-*-130-*-*-c-*-koi8-r"); - use DXVars; use DXUtil; use IO::Socket::INET; @@ -49,11 +50,15 @@ if ($ssid) { die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq $main::mycall; +my $host = 'localhost'; +my $port = 7301; -my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport); -die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock; -sendmsg('A', 'local'); -sendmsg('G', '2'); +my $sock = IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port); +die "Cannot connect to $host/$port ($!)\n" unless $sock; +sendmsg('I', $call); +sendmsg('I', 'set/gtk'); +#sendmsg('A', 'local'); +#sendmsg('G', '2'); sendmsg('I', 'set/page 500'); sendmsg('I', 'set/nobeep'); @@ -62,87 +67,197 @@ sendmsg('I', 'set/nobeep'); # +# +# +--------+-------+------------------------------------------------------------------------------------+ +# | _File | _Help | | +# +--------+-------+------------------------------------------------------------------------------------+ +# # main window -my $main = new Gtk::Window('toplevel'); +my $main = new Gtk2::Window('toplevel'); $main->set_default_size(600, 600); -$main->set_policy(0, 1, 0); -$main->signal_connect('destroy', sub { Gtk->exit(0); }); -$main->signal_connect('delete_event', sub { Gtk->exit(0); }); +$main->signal_connect('delete_event', sub { Gtk2->main_quit; }); $main->set_title("gtkconsole - The DXSpider Console - $call"); # the main vbox -my $vbox = new Gtk::VBox(0, 1); -$vbox->border_width(1); +my $vbox = new Gtk2::VBox(0, 1); $main->add($vbox); + # the menu bar my @menu = ( {path => '/_File', type => ''}, - {path => '/_File/Quit', callback => sub {Gtk->exit(0)}}, + {path => '/_File/Quit', callback => sub {Gtk2->main_quit}}, {path => '/_Help', type => ''}, {path => '/_Help/About'}, ); -my $accel = new Gtk::AccelGroup(); -my $itemf = new Gtk::ItemFactory('Gtk::MenuBar', '
', $accel); +my $itemf = new Gtk2::ItemFactory('Gtk2::MenuBar', '
'); $itemf->create_items(@menu); -$main->add_accel_group($accel); my $menu = $itemf->get_widget('
'); $vbox->pack_start($menu, 0, 1, 0); -$menu->show; -my $top = new Text(1); -my $toplist = $top->text; -$toplist->set_editable(0); -$toplist->sensitive(0); +# another hbox is packed as the bottom of the vbox +my $bhbox = Gtk2::HBox->new(0, 1); +$vbox->pack_end($bhbox, 1, 1, 0); + +# now pack two vboxes into the hbox +my $lhvbox = Gtk2::VBox->new(0, 1); +my $rhvbox = Gtk2::VBox->new(0, 1); +$bhbox->pack_start($lhvbox, 1, 1, 5); +$bhbox->pack_start(Gtk2::VSeparator->new, 0, 1, 0); +$bhbox->pack_end($rhvbox, 1, 1, 5); + +# first add a column type for the QRG +my $font = 'monospace 10'; +my $oddbg = 'light blue'; +my $evenbg = 'white'; + +Gtk2::SimpleList->add_column_type( 'qrg', + type => 'Glib::Scalar', + renderer => 'Gtk2::CellRendererText', + attr => sub { + my ($treecol, $cell, $model, $iter, $col_num) = @_; + my $info = $model->get ($iter, $col_num); + $cell->set(text => sprintf("%.1f", $info), font => $font); + } + ); + + +Gtk2::SimpleList->add_column_type( 'tt', + type => 'Glib::Scalar', + renderer => 'Gtk2::CellRendererText', + attr => sub { + my ($treecol, $cell, $model, $iter, $col_num) = @_; + my $info = $model->get ($iter, $col_num); + $cell->set(text => $info, font => $font); + } + ); -# add the handler for incoming messages from the node -my $tophandler = Gtk::Gdk->input_add($sock->fileno, ['read'], \&tophandler, $sock); -my $rbuf = ""; # used in handler -#$toplist->{signalid} = $toplist->signal_connect(insert_text => \&doinsert, $toplist); -#$bot->{signalid} = $bot->signal_connect(insert_text => \&botinsert, $bot); -$vbox->pack_start($top, 1, 1, 0); -$vbox->show; +# +# LEFT HAND SIDE +# + +# DX window +my $dxlist = Gtk2::SimpleList->new( + 'RxTime' => 'tt', + 'QRG' => 'qrg', + 'DX Call' => 'tt', + 'Grid' => 'tt', + 'Remarks' => 'tt', + 'By' => 'tt', + 'Grid' => 'tt', + 'TxTime' => 'tt', + ); +my $dxscroll = Gtk2::ScrolledWindow->new (undef, undef); +$dxscroll->set_shadow_type ('etched-out'); +$dxscroll->set_policy ('never', 'automatic'); +#$dxscroll->set_size_request (700, 400); +$dxscroll->add($dxlist); +$dxscroll->set_border_width(5); +$lhvbox->pack_start($dxscroll, 1, 1, 0); + +# The command list +my $cmdlist = Gtk2::SimpleList->new( + RxTime => 'tt', + Information => 'tt', + ); +my $cmdscroll = Gtk2::ScrolledWindow->new (undef, undef); +$cmdscroll->set_shadow_type ('etched-out'); +$cmdscroll->set_policy ('never', 'automatic'); +#$cmdscroll->set_size_request (700, 400); +$cmdscroll->add($cmdlist); +$cmdscroll->set_border_width(5); +$lhvbox->pack_start($cmdscroll, 1, 1, 0); -# the bottom handler -my $bot = new Gtk::Entry; -my $style = $toplist->style; -$style->font($main::font); -$bot->set_style($style); -$bot->set_editable(1); -$bot->signal_connect('activate', \&bothandler); -$bot->can_default(1); -$bot->grab_default; -$bot->show; -# a horizontal box -my $hbox = new Gtk::HBox; -$hbox->show; +# nice little separator +$lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0 ); # callsign and current date and time -my $calllabel = new Gtk::Label($call); -my $date = new Gtk::Label(cldatetime(time)); -Gtk->timeout_add(1000, \&updatetime); -$calllabel->show; -$date->show; - +my $hbox = new Gtk2::HBox; +my $calllabel = new Gtk2::Label($call); +my $date = new Gtk2::Label(cldatetime(time)); +$date->{tick} = Glib::Timeout->add(1000, \&updatetime, 0); $hbox->pack_start( $calllabel, 0, 1, 0 ); $hbox->pack_end($date, 0, 1, 0); +$lhvbox->pack_start($hbox, 0, 1, 0); +$lhvbox->pack_start(Gtk2::HSeparator->new, 0, 1, 0); +# the bottom handler +my $bot = new Gtk2::Entry; +$bot->set_editable(1); +$bot->signal_connect('activate', \&bothandler); +$bot->can_default(1); +$lhvbox->pack_end($bot, 0, 1, 0); +$bot->grab_default; -$vbox->pack_start($hbox, 0, 1, 0); - -# nice little separator -my $separator = new Gtk::HSeparator(); -$vbox->pack_start( $separator, 0, 1, 0 ); -$separator->show(); -$vbox->pack_start($bot, 0, 1, 0); +# +# RIGHT HAND SIDE +# +# The announce list +my $annlist = Gtk2::SimpleList->new( + RxTime => 'tt', + From => 'tt', + To => 'tt', + Announcement => 'tt', + ); +my $annscroll = Gtk2::ScrolledWindow->new (undef, undef); +$annscroll->set_shadow_type ('etched-out'); +$annscroll->set_policy ('automatic', 'automatic'); +#$annscroll->set_size_request (700, 400); +$annscroll->add($annlist); +$annscroll->set_border_width(5); +$rhvbox->pack_start($annscroll, 0, 1, 0); + +# The wwv list +my $wwvlist = Gtk2::SimpleList->new( + RxTime => 'tt', + From => 'tt', + SFI => 'int', + A => 'int', + K => 'int', + Remarks => 'tt', + Hour => 'tt' + ); +my $wwvscroll = Gtk2::ScrolledWindow->new (undef, undef); +$wwvscroll->set_shadow_type ('etched-out'); +$wwvscroll->set_policy ('never', 'automatic'); +#$wwvscroll->set_size_request (700, 200); +$wwvscroll->add($wwvlist); +$wwvscroll->set_border_width(5); +$rhvbox->pack_start($wwvscroll, 1, 1, 0); + +# The wcy list +my $wcylist = Gtk2::SimpleList->new( + RxTime => 'tt', + From => 'tt', + K => 'int', + ExpK => 'int', + A => 'int', + R => 'int', + SFI => 'int', + SA => 'tt', + GMF => 'tt', + Aurora => 'tt', + Time => 'tt' + ); +my $wcyscroll = Gtk2::ScrolledWindow->new (undef, undef); +$wcyscroll->set_shadow_type ('etched-out'); +$wcyscroll->set_policy ('never', 'automatic'); +#$wcyscroll->set_size_request (700, 200); +$wcyscroll->add($wcylist); +$wcyscroll->set_border_width(5); +$rhvbox->pack_start($wcyscroll, 1, 1, 0); + +my $sock_helper = Gtk2::Helper->add_watch($sock->fileno, 'in', \&tophandler, $sock); + # the main loop $main->show_all; $bot->grab_focus; -Gtk->main; +Gtk2->main; +exit(0); # # handlers @@ -154,20 +269,6 @@ sub updatetime 1; } -sub doinsert { - my ($self, $text) = @_; - - # we temporarily block this handler to avoid recursion - $self->signal_handler_block($self->{signalid}); - my $pos = $self->insert($self->{font}, $toplist->style->black, $toplist->style->white, $text); - $self->signal_handler_unblock($self->{signalid}); - - # we already inserted the text if it was valid: no need - # for the self to process this signal emission - $self->signal_emit_stop_by_name('insert-text'); - 1; -} - sub bothandler { my ($self, $data) = @_; @@ -178,59 +279,142 @@ sub bothandler senddata($msg); } +my $rbuf; + sub tophandler { - my ($socket, $fd, $flags) = @_; - if ($flags->{read}) { - my $offset = length $rbuf; - my $l = sysread($socket, $rbuf, 1024, $offset); - if (defined $l) { - my $freeze; - if ($l) { - while ($rbuf =~ s/^([^\015\012]*)\015?\012//) { - my $msg = $1; - $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; - $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters - $toplist->freeze unless $freeze++; - handlemsg($msg); - } - if ($freeze) { - $toplist->thaw; - $toplist->vadj->set_value($toplist->vadj->upper); - $toplist->vadj->value_changed; - } - } else { - Gtk->exit(0); + my ($fd, $condx, $socket) = @_; + + my $offset = length $rbuf; + my $l = sysread($socket, $rbuf, 1024, $offset); + if (defined $l) { + if ($l) { + while ($rbuf =~ s/^([^\015\012]*)\015?\012//) { + my $msg = $1; + handlemsg($msg); } } else { - Gtk->exit(0); + Gtk2->main_quit; } + } else { + Gtk2->main_quit; } + 1; + } sub handlemsg { - my $msg = shift; - my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; - if ($sort eq 'D') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'X') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'T') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'Y') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'V') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'N') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'W') { - $toplist->insert($toplist->{font}, undef, undef, "$line\n"); - } elsif ($sort eq 'Z') { - Gtk->exit(0); + my $line = shift; + + # this is truely evil and I bet there is a better way... + chomp $line; + my $list; + if ($line =~ /^'\w{2,4}',/) { + $list = eval qq([$line]); + } else { + $list = ['cmd', $line]; + } + unless ($@) { + no strict 'refs'; + my $cmd = shift @$list; + my $handle = "handle_$cmd"; + if (__PACKAGE__->can($handle)) { + __PACKAGE__->$handle($list); + } else { + push @$list, $cmd; + __PACKAGE__->handle_def($list); + } } } +sub handle_cmd +{ + my $self = shift; + my $ref = shift; + my ($t, $ts) = (time, ''); + my $s; + $s = ref $ref ? join ', ',@$ref : $ref; + + if (exists $cmdlist->{lasttime} != $t) { + $ts = tim($t); + $cmdlist->{lasttime} = $t; + } + + chomp $s; + push @{$cmdlist->{data}}, [$ts, $s]; +} + +sub handle_def +{ + my $self = shift; + my $ref = shift; + my $s; + $s = ref $ref ? join ', ',@$ref : $ref; + my ($t, $ts) = (time, ''); + + if (exists $cmdlist->{lasttime} != $t) { + $ts = tim($t); + $cmdlist->{lasttime} = $t; + } + + chomp $s; + push @{$cmdlist->{data}}, [$ts, $s]; +} + +sub handle_dx +{ + my $self = shift; + my $ref = shift; + my ($t, $ts) = (time, ''); + + if (exists $dxlist->{lasttime} != $t) { + $ts = tim($t); + $dxlist->{lasttime} = $t; + } + push @{$dxlist->{data}}, [$ts, @$ref[0,1,15,3,4,16], stim($ref->[2]) ]; + +} + +sub handle_ann +{ + my $self = shift; + my $ref = shift; + my ($t, $ts) = (time, ''); + my $s; + $s = ref $ref ? join ', ',@$ref : $ref; + + if (exists $cmdlist->{lasttime} != $t) { + $ts = tim($t); + $cmdlist->{lasttime} = $t; + } + + chomp $s; + push @{$cmdlist->{data}}, [$ts, @$ref[0,1,2]]; +} + +sub handle_wcy +{ + my $self = shift; + my $ref = shift; + my $s; + $s = ref $ref ? join ', ',@$ref : $ref; + + chomp $s; + push @{$cmdlist->{data}}, [tim(), @$ref[10,4,5,3,6,2,7,8,9,1] ]; +} + +sub handle_wwv +{ + my $self = shift; + my $ref = shift; + my $s; + $s = ref $ref ? join ', ',@$ref : $ref; + + chomp $s; + push @{$cmdlist->{data}}, [tim(), @$ref[6,2,3,4,5,1] ]; +} + # # subroutine # @@ -244,6 +428,19 @@ sub senddata sub sendmsg { my ($let, $msg) = @_; - $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; - $sock->print("$let$call|$msg\n"); +# $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; +# $sock->print("$let$call|$msg\n"); + $sock->print("$msg\n"); +} + +sub tim +{ + my $t = shift || time; + return sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0]; +} + +sub stim +{ + my $t = shift || time; + return sprintf "%02d:%02d", (gmtime($t))[2,1]; } diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index efaffb6c..e93370dd 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -101,6 +101,7 @@ $count = 0; itu => '0,ITU Zone', cq => '0,CQ Zone', enhanced => '5,Enhanced Client,yesno', + gtk => '5,Using GTK,yesno', senddbg => '8,Sending Debug,yesno', width => '0,Column Width', disconnecting => '9,Disconnecting,yesno', diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 7500d17d..52806706 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -600,6 +600,9 @@ sub disconnect sub prompt { my $self = shift; + + return if $self->{gtk}; # 'cos prompts are not a concept that applies here + my $call = $self->call; my $date = cldate($main::systime); my $time = ztime($main::systime); @@ -797,6 +800,18 @@ sub find_cmd_name { return $package; } +sub send +{ + my $self = shift; + if ($self->{gtk}) { + for (@_) { + $self->SUPER::send(dd(['cmd',$_])); + } + } else { + $self->SUPER::send(@_); + } +} + sub local_send { my ($self, $let, $buf) = @_; @@ -816,7 +831,13 @@ sub talk { my ($self, $from, $to, $via, $line) = @_; $line =~ s/\\5E/\^/g; - $self->local_send('T', "$to de $from: $line") if $self->{talk}; + if ($self->{talk}) { + if ($self->{gtk}) { + $self->local_send('T', dd(['talk',$to,$from,$via,$line,@_])); + } else { + $self->local_send('T', "$to de $from: $line"); + } + } Log('talk', $to, $from, $via?$via:$main::mycall, $line); # send a 'not here' message if required unless ($self->{here} && $from ne $to) { @@ -858,9 +879,14 @@ sub announce return if $_[0] ne $main::myalias && $_[0] ne $main::mycall; } return if $target eq 'SYSOP' && $self->{priv} < 5; - my $buf = "$to$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['ann', $to, $target, $text, @_]) + } else { + $buf = "$to$target de $_[0]: $text"; + $buf =~ s/\%5E/^/g; + $buf .= "\a\a" if $self->{beep}; + } $self->local_send($target eq 'WX' ? 'W' : 'N', $buf); } @@ -878,9 +904,14 @@ sub chat return unless grep uc $_ eq $target, @{$self->{user}->{group}}; $text =~ s/^\#\d+ //; - my $buf = "$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['chat', $to, $target, $text, @_]) + } else { + $buf = "$target de $_[0]: $text"; + $buf =~ s/\%5E/^/g; + $buf .= "\a\a" if $self->{beep}; + } $self->local_send('C', $buf); } @@ -935,6 +966,24 @@ sub dx_spot my $buf; if ($self->{ve7cc}) { $buf = VE7CC::dx_spot($self, @_); + } elsif ($self->{gtk}) { + my ($dxloc, $byloc); + + my $ref = DXUser->get_current($_[4]); + if ($ref) { + $byloc = $ref->qra; + $byloc = substr($byloc, 0, 4) if $byloc; + } + + my $spot = $_[1]; + $spot =~ s|/\w{1,4}$||; + $ref = DXUser->get_current($spot); + if ($ref) { + $dxloc = $ref->qra; + $dxloc = substr($dxloc, 0, 4) if $dxloc; + } + $buf = dd(['dx', @_, ($dxloc||''), ($byloc||'')]); + } else { $buf = $self->format_dx_spot(@_); $buf .= "\a\a" if $self->{beep}; @@ -958,8 +1007,14 @@ sub wwv return unless $filter; } - my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['wwv', @_]) + } else { + $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; + $buf .= "\a\a" if $self->{beep}; + } + $self->local_send('V', $buf); } @@ -977,8 +1032,13 @@ sub wcy return unless $filter; } - my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['wcy', @_]) + } else { + $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; + $buf .= "\a\a" if $self->{beep}; + } $self->local_send('Y', $buf); } @@ -989,7 +1049,11 @@ sub broadcast_debug foreach my $dxchan (DXChannel::get_all) { next unless $dxchan->{enhanced} && $dxchan->{senddbg}; - $dxchan->send_later('L', $s); + if ($dxchan->{gtk}) { + $dxchan->local_send('L', dd(['db', $s])); + } else { + $dxchan->local_send('L', $s); + } } } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index bca3b1da..840498c0 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -85,6 +85,7 @@ $v3 = 0; wantusstate => '0,Show US State,yesno', wantdxcq => '0,Show CQ Zone,yesno', wantdxitu => '0,Show ITU Zone,yesno', + wantgtk => '0,Want GTK interface,yesno', lastoper => '9,Last for/oper,cldatetime', nothere => '0,Not Here Text', registered => '9,Registered?,yesno', @@ -716,6 +717,11 @@ sub wantdxitu return _want('dxitu', @_); } +sub wantgtk +{ + return _want('gtk', @_); +} + sub wantlogininfo { my $self = shift; diff --git a/perl/Messages b/perl/Messages index e8a31087..db4a1370 100644 --- a/perl/Messages +++ b/perl/Messages @@ -121,6 +121,8 @@ package DXM; grayline2 => 'Location dd/mm/yyyy Dawn Rise Set Dusk', grids => 'DX Grid enabled for $_[0]', gridu => 'DX Grid disabled for $_[0]', + gtks => 'GTK output enabled for $_[0]', + gtku => 'GTK output disabled for $_[0]', illcall => 'Sorry, $_[0] is an invalid callsign', hasha => '$_[0] already exists in $_[1]', hashb => '$_[0] added to $_[1]',