zentara, I want to run your module but it fails on use Tk::ExecuteCommand; because my ActivePerl did not have it in lib. I found it on the net and saved it in ~\lib. then failed on Proc::Killfam within Tk::ExecuteCommand again I found it on the net but could not save it in ~\lib, I don't know why, even though I changed dir to share. so I can't run your script. could you help? regards, Marco. > --- zentara <[EMAIL PROTECTED]> wrote: > > On Thu, 08 Jul 2004 09:41:02 -0400, zentara > > <[EMAIL PROTECTED]> > > wrote: > > > > >>1./ Where can I locate a text or GUI-based menu > > program in Perl to bundle > > >>together a set of scripts and program. > > > > Hi, I thought this was a useful program to have, > so > > I perfected it a > > bit. I hope you find it useful. > > It can run repeatedly for a long time without > > gaining memory > > by the reuse of the widgets. > > > > #!/usr/bin/perl > > use warnings; > > use strict; > > use Tk; > > use Tk::Pane; > > > use Tk::ExecuteCommand; > > > > my %commands = ( > > #buttontext => command > > sleep => 'sleep 20', > > dir => 'dir', > > date => 'date', > > date1 => 'date; sleep 5; date;', > > ls => 'ls -la', > > users => 'cat /etc/passwd', > > who => 'who', > > whomai => 'whoami', > > ps => 'ps mauxww', > > top => 'top', > > cat_error => 'cat foobar' > > ); > > > > my $width = 90; > > my $height = 120; > > > > my $mw = MainWindow->new(); > > $mw->geometry($width.'x'.$height.'+100+100'); > > $mw->configure(-background => 'black'); > > > > $mw->Button(-text => 'Quit', > > -activebackground => 'red', > > -highlightbackground => 'yellow', > > -background => 'pink', > > -command=> sub{Tk::exit} )->pack; > > > > my $p = $mw->Scrolled('Pane', -scrollbars => > > 'oe',)->pack; > > > > foreach my $key (keys %commands){ > > > > $commands{'tl'}{$key} = > $mw->Toplevel(-background > > => > > 'lightsteelblue'); > > $commands{'tl'}{$key}->title($key); > > > > $commands{'ec'}{$key} = > > $commands{'tl'}{$key}->ExecuteCommand( > > -background => 'lightsteelblue', > > -command => $commands{$key}, > > -entryWidth => 50, > > -height => 10, > > -label => '', > > -text => 'Execute', > > )->pack; > > > > my $t = $commands{'ec'}{$key}->Subwidget( > 'text' > > ); # ROText widget > > $t->configure(-background => 'lightyellow'); > > > > my $f1 = > > $commands{'tl'}{$key}->Frame(-background => > 'black') > > ->pack(-expand => 1, -fill > > => 'x'); > > > > $f1->Button(-text => "Clear", > > -activebackground => 'lightyellow', > > -highlightbackground => 'white', > > -background => 'yellow', > > -command => sub { > > $t->delete( '1.0' => 'end' ); > > })->pack(-side =>'left', -padx => > > 70); > > > > > > $f1->Button(-text => "Get Status", > > -activebackground => 'lightgrey', > > -highlightbackground => 'white', > > -background => 'grey', > > -command => sub { > > my @return = > > $commands{'ec'}{$key}->get_status; > > #Returns a 2 element array of $? and $! from > > last command > > execution. > > $t->insert( 'end' => > > "\nStatus->\t\$?=$return[0]\t\$!=$return[1]\n\n"); > > $t->see('end'); > > })->pack(-side =>'left', -padx => 70); > > > > $f1->Button(-text => "Close", > > -activebackground => 'hotpink', > > -highlightbackground => 'white', > > -background => 'pink', > > -command => sub { > > $commands{'tl'}{$key}->withdraw; > > $commands{'button'}{$key}-> > > configure(-state => > > 'normal'); > > })->pack(-side => 'right', > > -padx => 70); > > > > $commands{'tl'}{$key}->withdraw; > > > > $commands{'button'}{$key} = $p->Button(-text => > > $key, > > -background => 'lightyellow', > > -activebackground => 'yellow', > > -command=>[\&execute, $key, ] ) > > ->pack(-fill => 'x',-expand => > > 1,-pady => 1); > > } > > > > MainLoop; > > sub execute { > > my $key = shift; > > > > $commands{'button'}{$key}->configure(-state => > > 'disabled'); > > > > $commands{'tl'}{$key}->deiconify; > > $commands{'tl'}{$key}->raise; > > > > $commands{'ec'}{$key}->bell; > > $commands{'ec'}{$key}->update; > > } > > __END__ > > > > > > -- > > I'm not really a human, but I play one on earth. > > http://zentara.net/japh.html > > > > -- > > To unsubscribe, e-mail: > > [EMAIL PROTECTED] > > For additional commands, e-mail: > > [EMAIL PROTECTED] > > <http://learn.perl.org/> > > <http://learn.perl.org/first-response> > > > > > > > > > > > __________________________________ > Do you Yahoo!? > Read only the mail you want - Yahoo! Mail SpamGuard. > http://promotions.yahoo.com/new_mail >
__________________________________ Do you Yahoo!? Yahoo! Mail - 50x more storage than other providers! http://promotions.yahoo.com/new_mail -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>