PerlTk - Need a data-entry (non-modal window) in MainWindow

Author

Need a data-entry (non-modal window) in MainWindow

joe.cipale@radisys.com

2005-01-08, 3:57 am

Greetings,

I have been baffeld by this issue for 2 days now and figure it is time
to ask an expert. I am trying to create a data-entry window (similar to
a cgi form from a web page) in the main window of an application.

Up to this point, I have not been succesful. Can one of you gurus give
me a hint or code example? The perl sub I am attempting to instantiate
this in is called blade_wizard(). I am also trying to pass a string of
data to the procedure call as well (as a proof of concept) for later
application setup.

Thanks in advance,

Joe

----------------------- Source Code -------------------------
#!/usr/bin/perl -w
#use Tk;
use Tk 800.000;
use Tk ':eventtypes';
require Tk::Dialog;

use subs qw($blade_wizard);

my $Version = "0.1";
my ($f, $d);
$mw = MainWindow->new;
$f = $mw->Frame(
-relief => sunken,
-borderwidth => 2
);

my $dlg_str ="";
#--------------------------------------------------------------------------------------------#
# Declare Procedures
#
#--------------------------------------------------------------------------------------------#
# blade_wizard parses the passed string and and determines how to draw
the blade dialog box #
#--------------------------------------------------------------------------------------------#
sub blade_wizard {
$d = $mw->add('Frame')->pack();
$d->Button(-text => "Exit",
-command => sub { exit; })->pack(-side => 'left');
$d->Button(-text => "Clear",
-command => sub { exit; })->pack(-side => 'left');
$d->Button(-text => "Save",
-command => sub { exit; })->pack(-side => 'bottom');
};
#--------------------------------------------------------------------------------------------#
# Declare Window components
#
#--------------------------------------------------------------------------------------------#
$mw->configure(-menu => my $menubar = $mw->Menu, -title => "Test
Diagnostic Framework");
my $file = $menubar->cascade(-label => '~File', -tearoff => 0);
my $system = $menubar->cascade(-label => '~System', -tearoff => 0);
my $edit = $menubar->cascade(-label => '~Edit', -tearoff => 0);
my $blade = $menubar->cascade(-label => '~Blades', -tearoff => 0);
my $help = $menubar->cascade(-label => '~Help', -tearoff => 0);
#--------------------------------------------------------------------------------------------#
# Declare sub-menu components
#
#--------------------------------------------------------------------------------------------#
# File Menu commands
#
#--------------------------------------------------------------------------------------------#
my $new = $file->command(
-label => 'Open',
-accelerator => 'Ctrl-o',
-underline => -0,
-command => sub { print "Open a diagnostic report\n" },
);
#$file->seperator;
$file->command(
-label => 'Save',
-accelerator => 'Ctrl-s',
-underline => -0,
-command => sub { print "Save a current diagnostic report\n" },
);
#$file->seperator;
$file->command(
-label => 'Save ~As',
-accelerator => 'Ctrl-a',
#-underline => -5,
-command => sub { print "Save a new diagnostic report\n" },
);
#$file->seperator;
$file->command(
-label => 'Run',
-accelerator => 'Ctrl-r',
-underline => -0,
-command => sub { print "Execute a captured diagnostic
script\n" },
);
#$file->seperator;
$file->command(
-label => 'Print',
-accelerator => 'Ctrl-p',
-underline => -0,
-command => sub { print "Print a diagnostic report\n" },
);
#$file->seperator;
$file->command(
-label => 'E~xit',
-accelerator => 'Ctrl-x',
#-underline => -0,
-command => sub { exit },
);
#--------------------------------------------------------------------------------------------#
# Chassis Menu commands
#
#--------------------------------------------------------------------------------------------#
# Nothing to instantiate at this time
$system->command(
-label => '',
-command => sub { print "Determine a chassis
configuration\n"},
);
#--------------------------------------------------------------------------------------------#
# Edit Menu commands
#
#--------------------------------------------------------------------------------------------#
# Nothing to instantiate at this time
$edit->command(
-label => '',
-command => sub { print "Edit a diagnostic script here\n"},
);
#--------------------------------------------------------------------------------------------#
# Board Wizard commands
#
#--------------------------------------------------------------------------------------------#
$blade->command(
-label => 'Compu~te',
-accelerator => 'Ctrl-t',
#-underline => -0,
#-command => sub { print "Execute CPU Blade diagnostic sweep\n"
},
-command => [ $dlg_str = "cpu".","."2"],
-command => [ \&blade_wizard],
);
#$file->seperator;
$blade->command(
-label => 'S~witch',
-accelerator => 'Ctrl-w',
#-underline => -0,
-command => sub { print "Execute Fabric Switch diagnostic
sweep\n" },
);
#$file->seperator;
$blade->command(
-label => 'Power S~upply',
-accelerator => 'Ctrl-u',
#-underline => -0,
-command => sub { print "Execute Power Supply diagnostic
sweep\n" },
);
#$file->seperator;
$blade->command(
-label => '~Fan',
-accelerator => 'Ctrl-f',
#-underline => -1,
-command => sub { print "Execute Fan Tray diagnostic sweep\n"
},
);
#$file->seperator;
$blade->command(
-label => '~Disk',
-accelerator => 'Ctrl-d',
#-underline => -0,
-command => sub { print "Execute Disk Drive diagnostic sweep\n"
},
);
#$file->seperator;
$blade->command(
-label => 'OE~M',
-accelerator => 'Ctrl-m',
#-underline => -0,
-command => sub { print "Evaluate a 3rd Party board\n" },
);
#--------------------------------------------------------------------------------------------#
# Help commands
#
#--------------------------------------------------------------------------------------------#
$help->command(
-label => 'A~bout',
-accelerator => 'Ctrl-b',
#-underline => -0,
-command => sub { print "Information about the Test Diagnostic
Framework\n" },
);
#$file->seperator;
$help->command(
-label => '~Version',
-accelerator => 'Ctrl-v',
#-underline => -0,
-command => sub { print "Version Information... $Version \n" },
);

#--------------------------------------------------------------------------------------------#
# Key bindings
#
#--------------------------------------------------------------------------------------------#
# File Menu Bindings
#
#--------------------------------------------------------------------------------------------#
$mw->bind($mw, "<Control-o>" => sub { print "Open a file...\n" });
#$mw->bind($mw, "<KeyPress-o>" => sub { print "Open a file...\n" });
$mw->bind($mw, "<Control-s>" => sub { print "Save the current
file...\n" });
#$mw->bind($mw, "<KeyPress-s>" => sub { print "Save the currrent
file...\n" });
$mw->bind($mw, "<Control-a>" => sub { print "Save a file...\n" });
#$mw->bind($mw, "<KeyPress-a>" => sub { print "Save Open a file...\n"
});
$mw->bind($mw, "<Control-r>" => sub { print "Execute a script
file...\n" });
#$mw->bind($mw, "<KeyPress-r>" => sub { print "Execute a script
file...\n" });
$mw->bind($mw, "<Control-p>" => sub { print "Print a file...\n" });
#$mw->bind($mw, "<KeyPress-p>" => sub { print "Print a file...\n" });
$mw->bind($mw, "<Control-x>" => sub { exit });
#$mw->bind($mw, "<KeyPress-x>" => sub { exit });

#--------------------------------------------------------------------------------------------#
# System Menu Bindings
#
#--------------------------------------------------------------------------------------------#

#--------------------------------------------------------------------------------------------#
# Edit Menu Bindings
#
#--------------------------------------------------------------------------------------------#

#--------------------------------------------------------------------------------------------#
# Blade Menu Bindings
#
#--------------------------------------------------------------------------------------------#
$mw->bind($mw, "<Control-t>" => sub { print "Diagnose specified CPU
blade...\n" });
#$mw->bind($mw, "<KeyPress-t>" => sub { print "Diagnose specified CPU
blade...\n" });
$mw->bind($mw, "<Control-w>" => sub { print "Diagnose specifed Fabric
Switch...\n" });
#$mw->bind($mw, "<KeyPress-w>" => sub { print "Diagnose specifed Fabric
Switch...\n" });
$mw->bind($mw, "<Control-u>" => sub { print "Diagnose specified Power
Supply...\n" });
#$mw->bind($mw, "<KeyPress-u>" => sub { print "Diagnose specified Power
Supply...\n" });
$mw->bind($mw, "<Control-f>" => sub { print "Diagnose specified Fan
Tray...\n" });
#$mw->bind($mw, "<KeyPress-f>" => sub { print "Diagnose specified Fan
Tray...\n" });
$mw->bind($mw, "<Control-d>" => sub { print "Diagnose specified Disk
Drive...\n" });
#$mw->bind($mw, "<KeyPress-d>" => sub { print "Diagnose specified Disk
Drive...\n" });
$mw->bind($mw, "<Control-m>" => sub { print "Check status of OEM(3rd
Party) blade...\n" });
#$mw->bind($mw, "<KeyPress-m>" => sub { print "Check status of OEM(3rd
Party) blade...\n"});

#--------------------------------------------------------------------------------------------#
# Help Menu Bindings
#
#--------------------------------------------------------------------------------------------#
$mw->bind($mw, "<Control-b>" => sub { print "About Test Diagnostic
Framework...\n" });
#$mw->bind($mw, "<KeyPress-b>" => sub { print "About Test Diagnostic
Framework...\n" });
$mw->bind($mw, "<Control-v>" => sub { print "Version of Test Diagnostic
Framework...$Version \n" });
#$mw->bind($mw, "<KeyPress-v>" => sub { print "Version of Test
Diagnostic Framework...$Version \n" });

MainLoop();

----------------------- Error Messages ------------------
joec@/home/joec/develop/tdf/perl: Unquoted string "sunken" may clash
with future reserved word at ./tdf_2.pl line 33.
Tk::Error: Failed to AUTOLOAD 'MainWindow::add' at ./tdf_2.pl line 44
Carp::croak at /usr/lib/perl5/5.8.0/Carp.pm line 191
Tk::Widget::__ANON__ at
/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Widget.pm
line 347
main::blade_wizard at ./tdf_2.pl line 44
Tk callback for .#menu.#menu#blades
Tk::__ANON__ at
/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/Tk.pm line 247
Tk::Menu::Invoke at
/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Menu.pm line
531
<ButtonRelease>
(command bound to event)

zentara

2005-01-08, 3:56 pm

On 7 Jan 2005 16:50:12 -0800, "joe.cipale@radisys.com"
<joe.cipale@radisys.com> wrote:

>I have been baffeld by this issue for 2 days now and figure it is time
>to ask an expert. I am trying to create a data-entry window (similar to
>a cgi form from a web page) in the main window of an application.
>
>Up to this point, I have not been succesful. Can one of you gurus give
>me a hint or code example? The perl sub I am attempting to instantiate
>this in is called blade_wizard(). I am also trying to pass a string of
>data to the procedure call as well (as a proof of concept) for later
>application setup.

Well your code was difficult to get to run. You have what is called
"cascading errors", where a syntax error, like a missing semicolon or
bracket, can cause a slew of errors that are just do to 1 tiny mistake.

First, there
were all sorts of word wrap errors, so try to keep your
comments and lines from extending too far.

Second, you have multiple commands for a widget here.

>#--------------------------------------------------------------------------------------------#
># Board Wizard commands
>#--------------------------------------------------------------------------------------------#
>$blade->command(
>-label => 'Compu~te',
>-accelerator => 'Ctrl-t',
>#-underline => -0,
>#-command => sub { print "Execute CPU Blade diagnostic sweep\n"
>},
>-command => [ $dlg_str = "cpu".","."2"],
>-command => [ \&blade_wizard],
> );
>#$file->seperator;

So after fixing all those, and quoting 'sunken', your script runs
without error.

What is it you want to do? You click on the menu, then what?
A toplevel window opens for you to input data? Or do you want the
input fields to be in the mainwindow below?

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

zentara

2005-01-08, 3:56 pm

On Sat, 08 Jan 2005 11:21:22 -0500, zentara <zentara@highstream.net>
wrote:

Here is an nice way to create a form in your mainwindow.
(from an earlier posted script)
When you are done getting the data, just "packforget" the
text widget.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my %info;

my $mw = MainWindow->new;
$mw->title("Data Entry");
my $f = $mw->Frame->pack( -side => 'bottom' );

$f->Button(
-text => "Exit",
-command => sub { exit }
)->pack( -side => 'left' );

#*********** Pass data to subroutine here***
$f->Button(
-text => "Save",
-command => [ \&Get_data, \%info ]
)->pack( -side => 'bottom' );

#***************************************
************************************
my $t = $mw->Scrolled(
"Text",
-width => 40,
-scrollbars => '',
-wrap => 'none'
)->pack( -expand => 1, -fill => 'both' );

foreach (
qw/Name Address City State Zip Phone Occupation
Company Business_address Business_phone/
)
{
my $w = $t->Label(
-text => "$_:",
-relief => 'groove',
-width => 20
);
$t->windowCreate( 'end', -window => $w );
$w = $t->Entry( -width => 20, -textvariable => \$info{$_} );
$t->windowCreate( 'end', -window => $w );
$t->insert( 'end', "\n" );
}
$t->configure( -state => 'disabled' );

MainLoop;

sub Get_data {
printf "\nSubroutine Get_data called";
#use YAML;
#print Dump([\@_]);

my $href = $_[0];
my %params = %{$href};
foreach my $key ( keys(%params) ) {
print "$key->$params{$key}\n";
}
}
__END__

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Sponsored Links