Jordan Sanders | 4 Dec 2007 17:47
Picon

Using Lispworks open-pipe in windows

Hi all,

I have written a perl script that is running an infinite loop keeping
track of windows that come to the foreground (if anyone knows of a
good way to do this in LISP, I'd be thrilled).  I am working on
Windows XP.  When I run:

cmd /c "D:\get-next-window.pl" from the run menu, it works great.  It
opens up a DOS style window that shows the window handles of all the
windows as they come to the foreground.  When I run:

(sys:call-system "cmd /c D:\\Perl\\get- next-window.pl") it works
great.  It even works great when I use call-system-showing-output.
Both bring up the DOS style window with the correct output.

But, I need some way to keep a handle on the windows that are being
returned, so I'm trying to run it with:

(setf test (sys:open-pipe "cmd /c D:\\Perl\\get- next-window.pl")).

That doesn't seem to run well at all!  First of all, it creates a
process in my taskmgr called "perl.exe" that is taking up 99% of my
CPU cycles.  Nothing else can run while this is running.  Second, I
can't seem to read anything that's there.  (read-line test) just
hangs, and (read-char-no-hang test) returns NIL.

Does anyone know what is going on, and how to use open-pipe correctly
on windows?

If it matters, here's a copy of the perl script:

#!perl -w

use Win32::GuiTest qw{:ALL};
use FileHandle;
use strict;
use Socket;
use IO::Handle; # thousands of lines just for autoflush :-(
use IO::Select;

socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC )
                                or  die "socketpair: $!";

CHILD->autoflush(1);
PARENT->autoflush(1);

my <at> windows;
my $pid = fork();
my $gotit = 1;
my $selchild = IO::Select->new;
my $selstdin = IO::Select->new;
my <at> childhandle;
my <at> parenthandle;
my $timeout = .1;
my $input;

$selchild->add(\*CHILD);
$selstdin->add(\*STDIN);

if ($pid) {
   while (1) {
      my <at> foreground = GetForegroundWindow();

      if (grep {$_ eq $foreground[0]} <at> windows) {
         ; #do nothing
      } else {
         push( <at> windows, $foreground[0]);
         print " <at> windows\n";
      }

      if ( <at> childhandle = $selchild->can_read($timeout)) {
         chomp(my $update = <CHILD>);
         print "Update = $update\n";
         $gotit = 0;
      }

      if ($gotit == 0) {
         my $winhandle = shift( <at> windows);
         print "$winhandle\n";
         $gotit = 1;
      }
   }

} else {

   while (1) {
         $input = <>;
         if ($input) {
            print PARENT $input;
         }
   }

Gmane