#!/usr/bin/perl -w use Tk; use strict; my $MW; my $Array_Index=""; MAIN: { debug("+MAIN"); my $my_ref; my $label ; my @file_references ; my $button ; my $i; $MW = MainWindow->new; $MW->title("test box 1"); $label = $MW -> Label(-text=>"Choose one option", -font=>"courierfont") -> pack; @file_references = ("Ref1", "Ref2", "Ref3", "Ref4"); $i=1; foreach $my_ref (@file_references) { $button = $MW -> Button(-text => "$my_ref", -command => [ \&do_button, "$my_ref,$i"])-> pack; $i++; } MainLoop(); debug("==MAIN - the first box has been closed"); if (length("$Array_Index") > 0) { $MW=MainWindow->new; $MW->OnDestroy([\&abort_routine]); $MW->title("test box 2"); $label = $MW -> Label(-text=>"This is the second box") -> pack; $label = $MW -> Label(-text=>"Index = $Array_Index", -font=>"courierfont") -> pack; $button = $MW -> Button(-text => "Shutdown and close", -command => [ \&abort_routine])-> pack(-side => 'bottom'); MainLoop(); } debug ("-MAIN"); } sub do_button { debug("+do_button"); my $params = shift; (my $ref, $Array_Index) = split (/,/,$params); debug("do_button Array_Index: $Array_Index"); # DO SOMETHING USEFUL HERE TO START A PROCESS $MW->destroy(); debug("-do_button"); } sub abort_routine { debug("+abort_routine"); debug("abort_routine Array_Index: $Array_Index"); # DO SOMETHING USEFUL HERE TO CLEAN UP THE PROCESS $MW->destroy(); debug("-abort_routine"); } sub debug { my @msg = shift; print @msg, "\n"; }