Tk Active Window problem

[mlibeson]

When running a perl script from a windows 2000 server command window, a GUI pops up as programmed and is active. After clicking a button in the active window, the window closes and a new window pops up, but the active window is the command window and not the gui window. I have tried focus and focusmodel and raise, but I have not been able to get the secondary windows to become active. The command window is always active.

Any ideas?


Michael Libeson

 

[icrf]

Can you create the new window prior to closing the initial one?

________________________________________
Andrew

I work for a gift card company!

 

[mlibeson]

I tried, but did not succeed. I am not sure why it is happening. It used to work fine in an older set-up.

Michael Libeson

 

[mlibeson]

Here is code you can use to try and help if you are interested:

use Tk;
use Tk::ProgressBar;

use Date::Manip;
$ENV{OS} = "Windows_NT";
&Date_Init("TZ=EST5EDT");

$| = 1;

### Font used for window pop-ups.
$main::tfont = 'courier 8';

### Position for pop-up windows.
$main::wmpos    = '250+20';
$main::wmwidth  = 550;
$main::wmheight = 375;

### Initialize VARS for storing lists of files
### for menu selection.
local (@main::logfiles) = ();
local (@main::rtmp) = ();

##############################
##### MENU Select Client #####
##############################

$main::mw = MainWindow->new;
$main::mw->geometry("${main::wmwidth}x${main::wmheight}+$main::wmpos");
$main::mw->minsize(${main::wmwidth},${main::wmheight});
$main::mw->maxsize(${main::wmwidth},${main::wmheight});
$main::mw->title("[Select Client]");
$main::r1 = $main::mw->Frame;
$main::r1->pack(-side => 'top',    -fill => 'x');
$main::r2 = $main::mw->Frame;
$main::r2->pack(-side => 'bottom', -fill => 'x');

$main::r1->Label(-text, 'Select Client:           ', -font => "$main::tfont")->pack(-side => 'top');
$main::r1->Radiobutton(-text => 'Client A         ', -value => 'a', -variable => \$main::setclient, -font => "$main::tfont")->pack(-side => 'top');
$main::r1->Radiobutton(-text => 'Client B         ', -value => 'b', -variable => \$main::setclient, -font => "$main::tfont")->pack(-side => 'top');
$main::r1->Radiobutton(-text => 'Client C         ', -value => 'c', -variable => \$main::setclient, -font => "$main::tfont")->pack(-side => 'top');
$main::done = $main::r2->Button(-text, "DONE", -command, [\&clientselect]);
$main::done->pack(-side, "bottom");
$main::mw->bind('<Control-c>' => sub{print STDOUT "Cancelled program.\n";writeln("ERR", "Cancelled program at ", &timestamp, "\n");exit(0);});
$main::mw->bind('<Return>' => [\&clientselect]);
MainLoop;

###################################
##### MENU Start From Scratch #####
###################################

### Get list of files that may be chosen for
### deletion as a result of starting from scratch.
if ( ! opendir(LOGDIR, ".")) {
     die "ERROR: Unable to open current directory. Exiting ...\n";
} else {
     @main::logfiles = sort(grep(/\.(str|str\.gz)$/i, readdir(LOGDIR)));
     closedir(LOGDIR);
}

foreach $_ (@main::logfiles) {
     if (-d "$_") { $_ = ''; }
}

$main::mw = MainWindow->new;
$main::mw->geometry("45x10+$main::wmpos");
$main::mw->minsize('45','10');
$main::mw->maxsize('45','10');
$main::mw->title("[Start From Scratch]");
$main::t0 = $main::mw->Frame;
$main::t0->pack(-side => 'top', -fill => 'x');
$main::t1 = $main::mw->Frame;
$main::t1->pack(-side => 'top', -fill => 'x');
$main::t2 = $main::mw->Frame;
$main::t2->pack(-side => 'top', -fill => 'x');
$main::r1 = $main::t1->Frame;
$main::r1->pack(-side => 'left', -fill => 'y');
$main::r11 = $main::t1->Frame;
$main::r11->pack(-side => 'right', -fill => 'y');

$main::t0->Label(-text, "If you want to start from scratch, select the\nfiles you want deleted, then click \"Scratch\",\notherwise click \"Ignore\"", -font => "$main::tfont", -fg => "blue", -relief => "ridge", -width => '60')->pack(-side => 'left', -fill => 'x');

$main::r1->Label(-text, "file1.txt\nfile2.txt\netc.txt\n", -font => "$main::tfont")->pack(-side => 'left');

$main::f = "";
$main::b = $main::r11->Listbox(-relief => 'raised', -setgrid => 'yes', -width => '45');
$main::scrollx = $main::r11->Scrollbar(-command => ['xview', $main::b], -orient => 'horizontal')->pack(-side => 'bottom', -fill => 'x');
$main::b->configure(-xscrollcommand => ['set', $main::scrollx]);
$main::b->pack(-side => 'left', -fill => 'y');
foreach $main::f (@main::logfiles) {
     next if ($main::f =~ /^\s*$/);
     $main::b->insert("end", $main::f);
}
$main::scroll = $main::r11->Scrollbar(-command => ['yview', $main::b])->pack(-side => 'right', -fill => 'y');
$main::b->configure(-yscrollcommand => ['set', $main::scroll]);
$main::b->pack(-fill => 'y');
$main::b->bind('<ButtonRelease>' => sub{print STDOUT $main::b->get('active'), "\n";push(@main::rtmp,$main::b->get('active'));$main::b->delete('active')});
$main::mw->bind('<KeyPress-a>' => sub{my ($rec) = "";while($rec = $main::b->get('0')) {print STDOUT $rec, "\n";push(@main::rtmp,$rec);$main::b->delete('0')}});

$main::done = $main::t2->Button(-text, "Scratch", -command, sub{
  @main::logfiles = ();
  @main::logfiles = grep(! /^\s*$/, @main::rtmp);
  undef(@main::rtmp);
  &main::scratch();
  $main::mw->destroy;
});
$main::done->pack(-side, "right");

$main::ignore = $main::t2->Button(-text, "Ignore", -command, sub{
  @main::logfiles = ();
  undef(@main::rtmp);
  $main::mw->destroy;
});
$main::ignore->pack(-side, "right");

# $main::mw->focus;
# $main::mw->raise();
# $main::mw->focusmodel('active');

$main::mw->bind('<Control-c>' => sub{print STDOUT "Cancelled program.\n";writeln("ERR", "Cancelled program at ", &timestamp, "\n");exit(0);});
$main::mw->bind('<KeyPress-s>' => sub{
  @main::logfiles = ();
  @main::logfiles = grep(! /^\s*$/, @main::rtmp);
  undef(@main::rtmp);
  &main::scratch();
  $main::mw->destroy;
});
$main::mw->bind('<KeyPress-i>' => sub{
  @main::logfiles = ();
  undef(@main::rtmp);
  $main::mw->destroy;
});
MainLoop;

sub clientselect {
     if ($main::setclient eq 'a') {
          $main::ca            = 0;
     } elsif ($main::setclient eq 'b') {
          $main::cb            = 1;
     } elsif ($main::setclient eq 'c') {
          $main::cc            = 1;
     } else {
          $main::other            = 0;
     }
     $main::mw->destroy;
}

sub scratch {
     if ( -e "file1.txt")          { system("del file1.txt"); }
     if ( -e "file2.txt")          { system("del file2.txt"); }
     if ( -e "etc.txt")            { system("del etc.txt"); }
     foreach $main::f (@main::logfiles) {
          system("del $main::f");
     }
}

sub timestamp {
     my %weekday = ('0','Sun','1','Mon','2','Tue','3','Wed','4','Thur','5','Fri','6','Sat');
     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
     $mon++;
     $year += 1900;
     return "$hour:$min:$sec:$mon\/$mday\/$year:$weekday{$wday}";
}

sub quit {
     exit(0);
}

1;

Michael Libeson

 

[tchatzi]

There is nothing wrong with your script. I tested it on Windows 2000 Server SP4.

It runs fine either you double click on it or run it from the cmd, the cmd window stays at the back all the time.

Your gui windows are the only active ones.

Something else is wrong.

TIMTOWTDI

 

[mlibeson]

Thanks. I have been going crazy trying to figure it out. I do not know where I am going to go from here, but at least I know I am not loosing my mind when it comes to programming in PERL.


Michael Libeson

 

[PaulTEG]

Michael,

have you some other app on your desktop with the 'always on top attribute' set, such as task manager, this 'might' screw with the window handling order

--Paul

cigless ...

 

[mlibeson]

I installed the system myself and do not recall setting such an attribute, but I am going to investigate it anyway. Thank you.


Michael Libeson

 

[mlibeson]

Problem solved!!!

Changed:

$main::mw->focus;

To:

$main::mw->focus(-force);


Michael Libeson

 

[tchatzi]

I don't get it though why it works for me and for you it needs '-force'.

I think that microsoft is behind all these!!!

TIMTOWTDI

 

[mlibeson]

Agreed. Who knows what the service packs and all those patches really do? Not to mention the constant changes to window behavior. They just keep adding what Unix-Like already have.


Michael Libeson