xrdesktop ported to Gtk2
Peter
peter at flytrace.com
Tue Jan 27 10:39:58 UTC 2015
Hello,
I've ported xrdesktop to Gtk2 and fixed some small bugs.
The software was tested during some months in everyday use, there is no
problem.
You can push it to ports tree with the same name or as xrdesktop2 (to
save the old one).
Best regards,
Peter TKATCHENKO
-------------- next part --------------
#!/usr/bin/perl -w
################################################################################
# xrdesktop, a gtk-perl frontend for rdesktop #
# Copyright (C) 2002 David Kovach #
# Ported to Gtk2 by Peter TKATCHENKO, 2014 #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the Free Software #
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA #
################################################################################
use Gtk2 -init;
use Gtk2::SimpleList;
use strict;
my $false = 0;
my $true = 1;
my $window;
my $box1;
my $scrolled_window1;
my $buttonbox1;
my $button1;
my $button2;
my $button3;
my $button4;
my $button5;
my $list1;
my %ip_hash;
my %uname_hash;
my %geom_hash;
my %fullscreen_hash;
my %bitmap_upd_hash;
my %kmap_hash;
my %license_hash;
my %passthru_hash;
my $machine_name;
my $machine_ip;
my $machine_uname;
my $machine_geom;
my $machine_fs;
my $machine_bitmap_upd;
my $machine_kmap;
my $machine_lic;
my $machine_passthru;
my $raw_data;
my $field_type;
my $field_data;
my $machina;
my @machines;
my @temp;
my $selected_machine;
my $selected_machine_ip;
my $selected_uname;
my $selected_geom;
my $selected_fs;
my $selected_bitmap_upd;
my $selected_kmap;
my $selected_kmap_hex;
my $selected_lic;
my $selected_passthru;
my $dialog1;
my $dialog_button_ok;
my $dialog_button_cancel;
my $name_entry;
my $ip_entry;
my $uname_entry;
my $dialog2;
my $combo1;
my $combo2;
my $fs_checkbox;
my $bmp_checkbox;
my $lic_checkbox;
my $passthru_entry;
my $passthru;
my $indexmax=0;
# the BIGASS list of keymaps. fear its awesome girth and stuff.
## 02/10/2003 updated the list to work with rdesktop 1.2 and the
## new way they do keyboard layouts...feh
## left all the hex codes for which i could not find mappings as comments
## in the hopes that someday it will get fixed.
## also note that some of these are approximations and may or may
## not work at all.
my %kmap_trans_hash = (
"Albanian" => "en-us",
# "Arabic 101" => "0x00000401",
# "Arabic 102 AZERTY" => "0x00020401",
# "Arabic 102" => "0x00010401",
# "Armenian Eastern" => "0x0000042b",
# "Armenian Western" => "0x0001042b",
# "Azeri Cyrillic" => "0x0000082c",
# "Azeri Latin" => "0x0000042c",
# "Belarusian" => "0x00000423",
# "Belgian Comma" => "0x0001080c",
"Belgian Dutch" => "be",
"Belgian French" => "be",
"Bulgarian Latin" => "bg",
# "Bulgarian" => "0x00000402",
"Canadian French legacy" => "cf",
"Canadian French" => "en-us",
# "Canadian Multilingual Standard" => "0x00011009",
# "Chinese MS-PinYin98" => "0xe00e0804",
# "Chinese NeiMa" => "0xe0050804",
# "Chinese QuanPin" => "0xe0010804",
# "Chinese ShuangPin" => "0xe0020804",
"Chinese US Keyboard" => "ch",
# "Chinese ZhengMa" => "0xe0030804",
# "Chinese Alphanumeric" => "0xe01f0404",
# "Chinese Array" => "0xe0050404",
# "Chinese Big5 Code" => "0xe0040404",
# "Chinese ChangJie" => "0xe0020404",
# "Chinese DaYi" => "0xe0060404",
# "Chinese New ChangJie" => "0xe0090404",
# "Chinese New Phoneetic" => "0xe0080404",
# "Chinese Phonetic" => "0xe0010404",
# "Chinese Quick" => "0xe0030404",
"Chinese US Keyboard" => "ch",
# "Chinese Unicode" => "0xe0070404",
# "Croatian" => "0x0000041a",
# "Croatian Specific" => "0x0000041a",
"Czech QWERTY" => "cz",
# "Czech ProgrammerS" => "0x00020405",
"Czech" => "cz",
"Danish" => "dk",
# "Devanagari INSCRIPT" => "0x00000439",
"Dutch" => "nl",
"Estonian" => "et",
# "Faeroese" => "0x00000438",
# "Farsi" => "0x00000429",
"Finnish" => "su",
"French" => "fr",
# "Gaelic" => "0x00011809",
# "Georgian" => "0x00000437",
# changed the German keymap string from "gr" to "de"
# at the behest of Tobias Mohrluder. Thanks!
# hopefully this is right :)
"German IBM" => "de",
"German" => "de",
# "Greek 220 Latin" => "0x00030408",
"Greek 220" => "gk",
# "Greek 319 Latin" => "0x00040408",
"Greek 319" => "gk",
"Greek Latin" => "gk",
# "Greek Polytonic" => "0x00060408",
"Greek" => "gk",
# "Hebrew" => "0x0000040d",
# "Hindi Traditional" => "0x00010439",
"Hungarian 101-key" => "hu",
"Hungarian" => "hu",
"Icelandic" => "is",
"Irish" => "en-us",
"Italian 142" => "it",
"Italian" => "it",
# "Japanese Input System" => "0xe0010411",
"Japanese" => "jp",
# "Japanese 106" => "0x00000411",
# "Japanese pc98x1" => "0x00000411",
# "Kazakh" => "0x0000043f",
# "Korean Hangul MS-IME98" => "0xe0010412",
"Korean Hangul" => "ko",
"Latin American" => "la",
"Latvian QWERTY" => "en-us",
# "Latvian" => "0x00000426",
# "Lithuanian IBM" => "0x00000427",
# "Lithuanian" => "0x00010427",
# "Macedonian FYROM" => "0x0000042f",
# "Marathi" => "0x0000044e",
"Norwegian" => "no",
"Polish 214" => "pl",
"Polish Programmers" => "pl",
"Portuguese Brazilian ABNT" => "br",
# "Portuguese Brazilian ABNT2" => "0x00010416",
"Portuguese" => "po",
"Romanian" => "ro",
"Russian Typewriter" => "ru",
"Russian" => "ru",
# "Russian KO18-R" => "0x00000419",
"Serbian Cyrillic" => "en-us",
# "Serbian Latin" => "0x0000081a",
"Slovak QWERTY" => "sl",
"Slovak" => "sl",
# "Slovak Programmers" => "0x0000041b",
"Slovenian" => "yu",
#altered spanish keyboard courtesy of Jonay Gomez
"Spanish Variation" => "es",
# "Spanish" => "0x0000040a",
"Swedish" => "sv",
"Swiss French" => "sf",
# "Swiss German" => "0x0000080",
# "Tamil" => "0x00000449",
# "Tatar" => "0x00000444",
# "Thai Kedmanee non-shiftlock" => "0x0002041e",
# "Thai Kedmanee" => "0x0000041e",
# "Thai Pattachote non-shiftlock" => "0x0003041e",
# "Thai Pattachote" => "0x0001041e",
"Turkish F" => "tr",
"Turkish Q" => "tr",
# "US English Talbe for IBM Arabic 238_L" => "0x00050409",
"US" => "en-us",
# "US phantom key ver" => "0x00000409",
# "Ukranian" => "0x00000422",
"English" => "en-gb",
"US Dvorak left" => "usl",
"US Dvorak right" => "usr",
"US Dvorak" => "dv",
"US International" => "en-us",
# "Uzbek Cyrillic" => "0x00000843",
# "Vietnamese" => "0x0000042a",
"yu" => "yu",
"cf" => "cf",
"us9" => "en-us",
);
# create the window
$window = Gtk2::Window->new;
$window->signal_connect( "delete_event", sub { Gtk2->main_quit } );
$window->set_default_size( 940, 600 );
$window->set_border_width( 2 );
$window->set_title("xrdesktop");
# make our first box
$box1 = Gtk2::VBox->new;
$box1->set_spacing(8);
# create the list, assign a signal to handle change of selection
$list1 = Gtk2::SimpleList->new ("Name", "text", "Hostname/IP", "text", "Username", "text", "Keymap", "text", "Geometry", "text", "Fullscreen", "text", "Force Bitmap Updates", "text", "Do Not Request License", "text", "CMD Vars", "text" );
# this is the scrolled window to put the List widget inside
$scrolled_window1 = Gtk2::ScrolledWindow->new;
$scrolled_window1->set_policy( "automatic", "automatic" );
$scrolled_window1->add_with_viewport( $list1 );
$box1->pack_start( $scrolled_window1, $true, $true, 0 );
$window->add( $box1 );
$list1->signal_connect( 'cursor-changed', \&list_sel_row );
$list1->signal_connect( 'row_activated', \&rdesque_connect );
# see the sub at the end of the script for info
populate_clist_from_config();
# Make some buttons
$buttonbox1 = new Gtk2::HButtonBox();
$button1 = new Gtk2::Button( "Connect" );
$button2 = new Gtk2::Button( "Add" );
$button3 = new Gtk2::Button( "Delete" );
$button4 = new Gtk2::Button( "Edit" );
$button5 = new Gtk2::Button( "Quit" );
# tell them what to do
$button1->signal_connect( "clicked", \&rdesque_connect );
$button2->signal_connect( "clicked", \&rdesque_add );
$button3->signal_connect( "clicked", \&rdesque_delete );
$button4->signal_connect( "clicked", \&rdesque_edit );
$button5->signal_connect( "clicked", sub { Gtk2->main_quit } );
# put stuff in the window
$box1->pack_start( $buttonbox1, $false, $false, 0 );
$buttonbox1->add( $button1 );
$buttonbox1->add( $button2 );
$buttonbox1->add( $button3 );
$buttonbox1->add( $button4 );
$buttonbox1->add( $button5 );
$window->show_all();
main Gtk2;
exit( 0 );
# Subroutines
# simple sub, to launch rdesktop with the configured info
# when the connect button is clicked. rather tidy :)
# remove the print line before the system call if you like quietness
sub rdesque_connect
{
my $buffer;
if( $selected_uname ) { $buffer = $buffer . " -u $selected_uname"; }
if( $selected_geom ) { $buffer = $buffer . " -g $selected_geom"; }
if( $selected_kmap_hex ) { $buffer = $buffer . " -k $selected_kmap_hex"; }
if( $selected_fs eq "true" ) { $buffer = $buffer . " -f"; }
if( $selected_bitmap_upd eq "true" ) { $buffer = $buffer . " -b"; }
if( $selected_lic eq "true" ) { $buffer = $buffer . " -l"; }
if( $selected_passthru ) { $buffer = $buffer . " $selected_passthru"; }
#make the title whatever the string of the selected machine name is
#instead of the machine's ip, courtesy of Jonay Gomez. thanks!
#moved up here at the behest of Tobias Mohrluder. Thanks!
if( $selected_machine ) { $buffer = $buffer . " -T \"$selected_machine\""; }
if( $selected_machine_ip ) { $buffer = $buffer . " $selected_machine_ip"; }
else { die "No IP/Hostname selected! Aborting.\n"; }
print "commandline is \"rdesktop $buffer\"\n";
system("rdesktop $buffer \&");
}
# sub to add an entry into the list of machines to choose from
# all this sub actually does is set up the dialog box to
# collect the info, the do_add_server() sub is what
# really does all the updating of info
# yes i know the layout stuff is effin nasty
# deal with it, i'm new at this gooey stuff... :P
sub rdesque_add
{
$dialog1 = new Gtk2::Dialog();
$dialog1->set_title("Add Server");
$dialog_button_ok = new Gtk2::Button( "Ok" );
$dialog_button_cancel = new Gtk2::Button( "Cancel" );
$dialog_button_ok->signal_connect( "clicked", \&do_add_server );
$dialog_button_cancel->signal_connect( "clicked", sub { $dialog1->destroy(); } );
$name_entry = new Gtk2::Entry( );
$ip_entry = new Gtk2::Entry( );
$uname_entry = new Gtk2::Entry( );
$passthru_entry = new Gtk2::Entry( );
my $label1 = new Gtk2::Label( "Enter a name for this server: " );
my $label2 = new Gtk2::Label( "Enter an IP address or hostname to connect to: " );
my $label3 = new Gtk2::Label( "Resolution: " );
my $label4 = new Gtk2::Label( "Username: " );
my $label5 = new Gtk2::Label( "Keyboard Mapping: " );
my $label6 = new Gtk2::Label( "Additional Variables to pass: " );
$label1->set_justify( "left" );
$label2->set_justify( "left" );
$label3->set_justify( "left" );
$label4->set_justify( "left" );
$label5->set_justify( "left" );
$label6->set_justify( "left" );
my $vbox1 = new Gtk2::VBox( $false, 0 );
my $vbox2 = new Gtk2::VBox( $false, 0 );
my $vbox3 = new Gtk2::VBox( $false, 0 );
my $vbox4 = new Gtk2::VBox( $false, 0 );
my $vbox5 = new Gtk2::VBox( $false, 0 );
my $vbox6 = new Gtk2::VBox( $false, 0 );
my $vbox7 = new Gtk2::VBox( $false, 0 );
my $hbox1 = new Gtk2::HBox( $false, 0 );
my $hbox2 = new Gtk2::HBox( $false, 0 );
my $hbox3 = new Gtk2::HBox( $false, 0 );
my $hbox4 = new Gtk2::HBox( $false, 0 );
my $hbox5 = new Gtk2::HBox( $false, 0 );
my $hbox6 = new Gtk2::HBox( $false, 0 );
my $hbox7 = new Gtk2::HBox( $false, 0 );
$combo1 = new Gtk2::Combo();
$combo2 = new Gtk2::Combo();
my @combo_list = ("640x480", "800x600", "1024x768", "1280x1024", "1600x1200");
my @combo_list2 = sort keys %kmap_trans_hash;
$combo1->set_popdown_strings( @combo_list );
$combo1->set_use_arrows_always( $true );
$combo1->set_value_in_list( $false, $true );
$combo2->set_popdown_strings( @combo_list2 );
$combo2->set_use_arrows_always( $true );
$combo2->set_value_in_list( $true, $false );
# $combo2->entry->set_text( "US" );
$fs_checkbox = new Gtk2::CheckButton( "Fullscreen On" );
$bmp_checkbox = new Gtk2::CheckButton( "Force Bitmap Update" );
$lic_checkbox = new Gtk2::CheckButton( "Do Not Request License" );
$dialog1->vbox->set_homogeneous( $false );
$dialog1->vbox->pack_start( $hbox1, $false, $false, 0 );
$hbox1->pack_start( $vbox1, $false, $false, 0 );
$vbox1->pack_start( $label1, $false, $false, 0 );
$vbox1->pack_start( $name_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox2, $false, $false, 0 );
$hbox2->pack_start( $vbox2, $false, $false, 0 );
$vbox2->pack_start( $label2, $false, $false, 0 );
$vbox2->pack_start( $ip_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox4, $false, $false, 0 );
$hbox4->pack_start( $vbox4, $false, $false, 0 );
$vbox4->pack_start( $label4, $false, $false, 0 );
$vbox4->pack_start( $uname_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox7, $false, $false, 0 );
$hbox7->pack_start( $vbox7, $false, $false, 0 );
$vbox7->pack_start( $label6, $false, $false, 0 );
$vbox7->pack_start( $passthru_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox3, $false, $false, 0 );
$hbox3->pack_start( $vbox3, $false, $false, 0 );
$vbox3->pack_start( $label3, $false, $false, 0 );
$vbox3->pack_start( $combo1, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox5, $false, $false, 0 );
$hbox5->pack_start( $vbox5, $false, $false, 0 );
$vbox5->pack_start( $label5, $false, $false, 0 );
$vbox5->pack_start( $combo2, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox6, $false, $false, 0 );
$hbox6->pack_start( $vbox6, $false, $false, 0 );
$vbox6->pack_start( $fs_checkbox, $false, $false, 0 );
$vbox6->pack_start( $bmp_checkbox, $false, $false, 0 );
$vbox6->pack_start( $lic_checkbox, $false, $false, 0 );
$dialog1->action_area->pack_start( $dialog_button_ok, $true, $true, 0 );
$dialog1->action_area->pack_start( $dialog_button_cancel, $true, $true, 0 );
$name_entry->set_text( $selected_machine );
$ip_entry->set_text( $ip_hash{$selected_machine} );
$uname_entry->set_text( $uname_hash{$selected_machine} );
$passthru_entry->set_text( $passthru_hash{$selected_machine} );
$combo1->entry->set_text( $geom_hash{$selected_machine} );
$combo2->entry->set_text( $kmap_hash{$selected_machine} );
if( $fullscreen_hash{$selected_machine} eq "true")
{
$fs_checkbox->set_active( $true );
}
else { $fs_checkbox->set_active( $false ); }
if( $bitmap_upd_hash{$selected_machine} eq "true" )
{
$bmp_checkbox->set_active( $true );
}
else { $bmp_checkbox->set_active( $false ); }
if( $license_hash{$selected_machine} eq "true" )
{
$lic_checkbox->set_active( $true );
}
else { $lic_checkbox->set_active( $false ); }
$dialog1->show_all();
}
# remove a machine entry from the list
sub rdesque_delete
{
my $name_deleted;
my $ip_deleted;
$name_deleted = $selected_machine;
$ip_deleted = $ip_hash{$selected_machine};
delete $ip_hash{$selected_machine};
delete $uname_hash{$selected_machine};
delete $geom_hash{$selected_machine};
delete $fullscreen_hash{$selected_machine};
delete $bitmap_upd_hash{$selected_machine};
delete $kmap_hash{$selected_machine};
delete $license_hash{$selected_machine};
delete $passthru_hash{$selected_machine};
write_out_config();
print "Server deleted: name = $name_deleted, ip/hostname = $ip_deleted\n";
populate_clist_from_config();
}
# change an existing entry in the list
# much like the rdesque_add() sub, all this does
# set up a dialog to display the info and change it
# all the real legwork is done by do_edit_server()
# yes, the layout stuff is nasty, see comments for rdesque_add()
sub rdesque_edit
{
$dialog2 = new Gtk2::Dialog();
$dialog_button_ok = new Gtk2::Button( "Ok" );
$dialog_button_cancel = new Gtk2::Button( "Cancel" );
$dialog_button_ok->signal_connect( "clicked", \&do_edit_server );
$dialog_button_cancel->signal_connect( "clicked", sub { $dialog2->destroy(); } );
$name_entry = new Gtk2::Entry( );
$ip_entry = new Gtk2::Entry( );
$uname_entry = new Gtk2::Entry( );
$passthru_entry = new Gtk2::Entry( );
my $label1 = new Gtk2::Label( "Enter a name for this server: " );
my $label2 = new Gtk2::Label( "Enter an IP address or hostname to connect to: ");
my $label3 = new Gtk2::Label( "Resolution: " );
my $label4 = new Gtk2::Label( "Username: " );
my $label5 = new Gtk2::Label( "Keyboard Mapping: " );
my $label6 = new Gtk2::Label( "Additional Variables to pass: " );
$label1->set_justify( "left" );
$label2->set_justify( "left" );
$label3->set_justify( "left" );
$label4->set_justify( "left" );
$label5->set_justify( "left" );
$label6->set_justify( "left" );
my $vbox1 = new Gtk2::VBox( $false, 0 );
my $vbox2 = new Gtk2::VBox( $false, 0 );
my $vbox3 = new Gtk2::VBox( $false, 0 );
my $vbox4 = new Gtk2::VBox( $false, 0 );
my $vbox5 = new Gtk2::VBox( $false, 0 );
my $vbox6 = new Gtk2::VBox( $false, 0 );
my $vbox7 = new Gtk2::VBox( $false, 0 );
my $hbox1 = new Gtk2::HBox( $false, 0 );
my $hbox2 = new Gtk2::HBox( $false, 0 );
my $hbox3 = new Gtk2::HBox( $false, 0 );
my $hbox4 = new Gtk2::HBox( $false, 0 );
my $hbox5 = new Gtk2::HBox( $false, 0 );
my $hbox6 = new Gtk2::HBox( $false, 0 );
my $hbox7 = new Gtk2::HBox( $false, 0 );
$combo1 = new Gtk2::Combo();
$combo2 = new Gtk2::Combo();
my @combo_list = ("640x480", "800x600", "1024x768", "1280x1024", "1600x1200");
my @combo_list2 = sort keys %kmap_trans_hash;
$combo1->set_popdown_strings( @combo_list );
$combo1->set_use_arrows_always( $true );
$combo1->set_value_in_list( $false, $true );
$combo2->set_popdown_strings( @combo_list2 );
$combo2->set_use_arrows_always( $true );
$combo2->set_value_in_list( $true, $false );
$fs_checkbox = new Gtk2::CheckButton( "Fullscreen On" );
$bmp_checkbox = new Gtk2::CheckButton( "Force Bitmap Update" );
$lic_checkbox = new Gtk2::CheckButton( "Do Not Request License" );
$dialog2->vbox->set_homogeneous( $false );
$dialog2->vbox->pack_start( $hbox1, $false, $false, 0 );
$hbox1->pack_start( $vbox1, $false, $false, 0 );
$vbox1->pack_start( $label1, $false, $false, 0 );
$vbox1->pack_start( $name_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox2, $false, $false, 0 );
$hbox2->pack_start( $vbox2, $false, $false, 0 );
$vbox2->pack_start( $label2, $false, $false, 0 );
$vbox2->pack_start( $ip_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox4, $false, $false, 0 );
$hbox4->pack_start( $vbox4, $false, $false, 0 );
$vbox4->pack_start( $label4, $false, $false, 0 );
$vbox4->pack_start( $uname_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox7, $false, $false, 0 );
$hbox4->pack_start( $vbox7, $false, $false, 0 );
$vbox4->pack_start( $label6, $false, $false, 0 );
$vbox4->pack_start( $passthru_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox3, $false, $false, 0 );
$hbox3->pack_start( $vbox3, $false, $false, 0 );
$vbox3->pack_start( $label3, $false, $false, 0 );
$vbox3->pack_start( $combo1, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox6, $false, $false, 0 );
$hbox6->pack_start( $vbox6, $false, $false, 0 );
$vbox6->pack_start( $label5, $false, $false, 0 );
$vbox6->pack_start( $combo2, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox5, $false, $false, 0 );
$hbox5->pack_start( $vbox5, $false, $false, 0 );
$vbox5->pack_start( $fs_checkbox, $false, $false, 0 );
$vbox5->pack_start( $bmp_checkbox, $false, $false, 0 );
$vbox5->pack_start( $lic_checkbox, $false, $false, 0 );
$dialog2->action_area->pack_start( $dialog_button_ok, $true, $true, 0 );
$dialog2->action_area->pack_start( $dialog_button_cancel, $true, $true, 0 );
$name_entry->set_text( $selected_machine );
$ip_entry->set_text( $ip_hash{$selected_machine} );
$uname_entry->set_text( $uname_hash{$selected_machine} );
$passthru_entry->set_text( $passthru_hash{$selected_machine} );
$combo1->entry->set_text( $geom_hash{$selected_machine} );
$combo2->entry->set_text( $kmap_hash{$selected_machine} );
if( $fullscreen_hash{$selected_machine} eq "true")
{
$fs_checkbox->set_active( $true );
}
else { $fs_checkbox->set_active( $false ); }
if( $bitmap_upd_hash{$selected_machine} eq "true" )
{
$bmp_checkbox->set_active( $true );
}
else { $bmp_checkbox->set_active( $false ); }
if( $license_hash{$selected_machine} eq "true" )
{
$lic_checkbox->set_active( $true );
}
else { $lic_checkbox->set_active( $false ); }
$dialog2->set_title("Edit Server: $selected_machine");
$dialog2->show_all();
}
# handler for when a row is selected, grabs info from the selected row
# looks the corresponding values up in the hash and
# stuffs them into variables to be used in other subs
sub list_sel_row
{
my $selection = ($list1->get_selected_indices)[0];
my @row = @{(@{$list1->{data}})[$selection]};
my $fs_tf;
my $bmp_tf;
$selected_machine = $row[0];
$selected_machine_ip = $ip_hash{$selected_machine};
$selected_uname = $uname_hash{$selected_machine};
$selected_geom = $geom_hash{$selected_machine};
$selected_fs = $fullscreen_hash{$selected_machine};
$selected_bitmap_upd = $bitmap_upd_hash{$selected_machine};
$selected_lic = $license_hash{$selected_machine};
$selected_kmap = $kmap_hash{$selected_machine};
$selected_kmap_hex = $kmap_trans_hash{$selected_kmap};
$selected_passthru = $passthru_hash{$selected_machine};
if( $selected_fs eq "true" ) { $fs_tf = "ON"; }
else { $fs_tf = "OFF"; }
if( $selected_bitmap_upd eq "true" ) { $bmp_tf = "Forcing Bitmap Updates"; }
else { $bmp_tf = "not Forcing Bitmap Updates"; }
print "You selected \"$selected_machine\", with the IP \"$selected_machine_ip\", Geometry is \"$selected_geom\"\nUsername is \"$selected_uname\", Fullscreen is $fs_tf, $bmp_tf\nKeyboard Mapping is \"$selected_kmap\"\n\n";
}
sub list_exec_row {
return 1 unless $selected_machine_ip;
my ($w, $ev) = @_;
if ($ev->{type} eq '2button_press' and $ev->{button} == 1) {
# well, probably we should emulate proper signal marshalling
# for 'click' on the 'Connect' button, but for the moment it's
# enough to simply call 'rdesque_connect'
# list double-click patch by Alexey Morozov
&rdesque_connect;
}
return 1;
}
# fairly simple, just spits out a config file based on the
# data contained in the hashes
sub write_out_config
{
my $machina_p;
my @machines_p;
my $count = 1;
unlink( "$ENV{HOME}/.xrdesktop_config" );
# fixed by Ken Caruso
open( CONFIG, ">$ENV{HOME}/.xrdesktop_config" );
select( CONFIG );
print "\# NO USER SERVICABLE PARTS. AT ALL.\n";
print "#\n\n";
@machines_p = keys %ip_hash;
foreach $machina_p (sort @machines_p)
{
print "# Entry $count\n";
print "Name=$machina_p\n";
print "IP=$ip_hash{$machina_p}\n";
print "Uname=$uname_hash{$machina_p}\n";
print "Geometry=$geom_hash{$machina_p}\n";
print "Fullscreen=$fullscreen_hash{$machina_p}\n";
print "Bitmap_Updates=$bitmap_upd_hash{$machina_p}\n";
print "Keymap=$kmap_hash{$machina_p}\n";
print "NoReqLic=$license_hash{$machina_p}\n";
print "Passthru=$passthru_hash{$machina_p}\n\n";
$count++;
}
select( STDOUT );
close( CONFIG );
}
# does the actual adding of the server to the hash and config files
# since the rdesque_add() sub just creates the dialog.
# this is the one linked to the "ok" button in the add dialog
sub do_add_server
{
my $name_added = $name_entry->get_text();
my $ip_added = $ip_entry->get_text();
my $uname_added = $uname_entry->get_text();
my $reso = $combo1->entry->get_text();
my $kmap = $combo2->entry->get_text();
my $pthru = $passthru_entry->get_text();
my $fs_state;
my $bmp_state;
my $lic_state;
if( $fs_checkbox->get_active ) {$fs_state = "true";}
else {$fs_state = "false";}
if( $bmp_checkbox->get_active ) {$bmp_state = "true";}
else {$bmp_state = "false";}
if( $lic_checkbox->get_active ) {$lic_state = "true";}
else {$lic_state = "false";}
chomp $name_added;
chomp $ip_added;
chomp $uname_added;
chomp $reso;
chomp $fs_state;
chomp $bmp_state;
chomp $lic_state;
chomp $kmap;
chomp $pthru;
my $check_dupe_key = exists $ip_hash{$name_added};
if( $name_added ne "" && $ip_added ne "" && $check_dupe_key != $true )
{
$ip_hash{$name_added} = $ip_added;
$uname_hash{$name_added} = $uname_added;
$geom_hash{$name_added} = $reso;
$fullscreen_hash{$name_added} = $fs_state;
$bitmap_upd_hash{$name_added} = $bmp_state;
$license_hash{$name_added} = $lic_state;
$kmap_hash{$name_added} = $kmap;
$passthru_hash{$name_added} = $pthru;
# print "Adding: $name_added, $pthru\n";
write_out_config();
# print "Added: name=$name_added, ip/hostname=$ip_added, username=$uname_added\nResolution=$reso, Fullscreen=$fs_state, Force Bitmap Updates=$bmp_state\nKeyboard Mapping=$kmap\n\n";
$dialog1->destroy();
populate_clist_from_config();
}
else
{
my $field1;
my $doh_dialog = new Gtk2::Dialog();
$doh_dialog->title("Er....");
my $doh_ok = new Gtk2::Button( "Ok" );
$doh_ok->signal_connect( "clicked", sub { $doh_dialog->destroy(); } );
my $doh_label = new Gtk2::Label();
if( $name_added eq "" )
{
$field1 = "You left the Name field blank.\nConfig NOT updated";
$doh_label->set_text( $field1 );
}
elsif( $ip_added eq "" )
{
$field1 = "You left the IP/Hostname field blank.\nConfig NOT updated";
$doh_label->set_text( $field1 );
}
elsif( $check_dupe_key )
{
$doh_label->set_text( "An entry named \"$name_added\" already exists.\nPlease choose another name." );
}
else
{
$field1 = "***CRITICAL ERROR***";
$doh_label->set_text( $field1 );
}
$doh_dialog->vbox->pack_start( $doh_label, $true, $true, 0 );
$doh_dialog->action_area->pack_start( $doh_ok, $true, $true, 0 );
$doh_dialog->show_all();
}
}
# does the actual editing of the server in the hash and config
# files since the rdesque_edit() sub just creates the dialog.
# this is the one linked to the "ok button in the dialog
sub do_edit_server
{
my $name_edited = $name_entry->get_text();
my $ip_edited = $ip_entry->get_text();
my $uname_edited = $uname_entry->get_text();
my $pthru = $passthru_entry->get_text();
my $reso = $combo1->entry->get_text();
my $kmap = $combo2->entry->get_text();
my $fs_state;
my $bmp_state;
my $lic_state;
if( $fs_checkbox->get_active ) {$fs_state = "true";}
else {$fs_state = "false";}
if( $bmp_checkbox->get_active ) {$bmp_state = "true";}
else {$bmp_state = "false";}
if( $lic_checkbox->get_active ) {$lic_state = "true";}
else {$lic_state = "false";}
chomp $name_edited;
chomp $ip_edited;
chomp $uname_edited;
chomp $reso;
chomp $fs_state;
chomp $bmp_state;
chomp $lic_state;
chomp $kmap;
chomp $pthru;
if( $name_edited ne "" && $ip_edited ne "" )
{
my $old_name = $selected_machine;
my $old_ip = $ip_hash{$selected_machine};
delete $ip_hash{$selected_machine};
$ip_hash{$name_edited} = $ip_edited;
delete $uname_hash{$selected_machine};
$uname_hash{$name_edited} = $uname_edited;
delete $geom_hash{$selected_machine};
$geom_hash{$name_edited} = $reso;
delete $fullscreen_hash{$selected_machine};
$fullscreen_hash{$name_edited} = $fs_state;
delete $bitmap_upd_hash{$selected_machine};
$bitmap_upd_hash{$name_edited} = $bmp_state;
delete $license_hash{$selected_machine};
$license_hash{$name_edited} = $lic_state;
delete $kmap_hash{$selected_machine};
$kmap_hash{$name_edited} = $kmap;
delete $passthru_hash{$selected_machine};
$passthru_hash{$name_edited} = $pthru;
write_out_config();
print "Old data: name = $old_name, ip/hostname = $old_ip\n";
print "New data: name = $name_edited, ip/hostname = $ip_edited\n";
$dialog2->destroy();
populate_clist_from_config();
}
else
{
my $field1;
my $doh_dialog = new Gtk2::Dialog();
$doh_dialog->title("Er....");
my $doh_ok = new Gtk2::Button( "Ok" );
$doh_ok->signal_connect( "clicked", sub { $doh_dialog->destroy(); } );
if( $name_edited eq "" ) { $field1 = "Name"; }
elsif( $ip_edited eq "" ) { $field1 = "IP/Hostname"; }
else { $field1 = "***CRITICAL ERROR***"; }
my $doh_label = new Gtk2::Label( "You left the $field1 field blank.\nConfig NOT updated." );
$doh_dialog->vbox->pack_start( $doh_label, $true, $true, 0 );
$doh_dialog->action_area->pack_start( $doh_ok, $true, $true, 0 );
$doh_dialog->show_all();
}
}
# reads in the config file (~/.xrdesktop_config by default)
# plugs all the data into a hash ($ip_hash) and
# sets up the $list1 widget with the data in the hash
sub populate_clist_from_config
{
unless( -e "$ENV{HOME}/.xrdesktop_config") { write_out_config();}
open( CONFIG, "$ENV{HOME}/.xrdesktop_config");
while( <CONFIG> )
{
# ignore comments and blank lines
next if /^#/;
next if /^$/;
# get me some data
$raw_data = $_;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
# stuff the first line (hopefully Name) into vars
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the second line (hopefully IP) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the third line (hopefully Uname) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the fourth line (hopefully Geometry) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the fifth line (hopefully Fullscreen) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the sixth line (hopefully Bitmap_Updates) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the seventh line (hopefully Keymap) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the eighth line (hopefully NoReqLic) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the ninth line (hopefully Passthru) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data,2;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# finally, stuff it all into the hashes
chomp $machine_name;
chomp $machine_ip;
chomp $machine_uname;
chomp $machine_geom;
chomp $machine_fs;
chomp $machine_bitmap_upd;
chomp $machine_kmap;
chomp $machine_passthru;
$ip_hash{$machine_name} = $machine_ip;
$uname_hash{$machine_name} = $machine_uname;
$geom_hash{$machine_name} = $machine_geom;
$fullscreen_hash{$machine_name} = $machine_fs;
$bitmap_upd_hash{$machine_name} = $machine_bitmap_upd;
$license_hash{$machine_name} = $machine_lic;
$kmap_hash{$machine_name} = $machine_kmap;
$passthru_hash{$machine_name} = $machine_passthru;
}
close CONFIG;
# and last, but not least, stuff it all into the clist
for (my $n=$indexmax-1; $n>=0; $n--)
{
splice @{ $list1->{data} }, $n, 1;
}
@machines = keys %ip_hash;
$indexmax = 0;
foreach $machina (sort @machines)
{
push @{$list1->{data}}, [$machina, $ip_hash{$machina}, $uname_hash{$machina}, $kmap_hash{$machina}, $geom_hash{$machina}, $fullscreen_hash{$machina}, $bitmap_upd_hash{$machina}, $license_hash{$machina}, $passthru_hash{$machina} ];
$indexmax++;
}
}
More information about the freebsd-ports
mailing list