add cross-platform process termination and pipe event handlers

git-svn-id: trunk@8256 -

lcl/alllclunits.pp

@@ -42,7 +42,7 @@ uses
   InterfaceBase,
   IntfGraphics,
   // components and functions
-  LCLClasses,
+  LCLClasses, AsyncProcess,
   StdActns, Buttons, Extctrls, Calendar, Clipbrd, Forms, LCLIntf, Spin,
   Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
   Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,

lcl/include/intfbaselcl.inc

@@ -31,6 +31,16 @@ procedure TWidgetSet.AddEventHandler(AHandle: THandle; AFlags: dword;
 begin
 end;
 
+procedure TWidgetSet.AddProcessEventHandler(AHandle: THandle; 
+  AEventHandler: TChildExitEvent; AData: PtrInt);
+begin
+end;
+
+procedure TWidgetSet.AddPipeEventHandler(AHandle: THandle; 
+  AEventHandler: TPipeEvent; AData: PtrInt);
+begin
+end;
+
 procedure TWidgetSet.AttachMenuToWindow(AMenuObject: TComponent);
 begin
 end;
@@ -553,6 +563,14 @@ procedure TWidgetSet.RemoveEventHandler(AHandle: THandle);
 begin
 end;
 
+procedure TWidgetSet.RemoveProcessEventHandler(AHandle: THandle);
+begin
+end;
+
+procedure TWidgetSet.RemovePipeEventHandler(AHandle: THandle);
+begin
+end;
+
 function TWidgetSet.ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer;
 begin
   Result := ReleaseDC(hWnd, DC);

lcl/include/lclintf.inc

@@ -39,6 +39,16 @@ begin
   WidgetSet.AddEventHandler(AHandle, AFlags, AEventHandler, AData);
 end;
 
+procedure AddPipeEventHandler(AHandle: THandle; AEventHandler: TPipeEvent; AData: PtrInt);
+begin
+  WidgetSet.AddPipeEventHandler(AHandle, AEventHandler, AData);
+end;
+
+procedure AddProcessEventHandler(AHandle: THandle; AEventHandler: TChildExitEvent; AData: PtrInt);
+begin
+  WidgetSet.AddProcessEventHandler(AHandle, AEventHandler, AData);
+end;
+
 procedure AttachMenuToWindow(AMenuObject: TComponent);
 begin
   WidgetSet.AttachMenuToWindow(AMenuObject);
@@ -386,6 +396,16 @@ begin
   WidgetSet.RemoveEventHandler(AHandle);
 end;
 
+procedure RemoveProcessEventHandler(AHandle: THandle);
+begin
+  WidgetSet.RemoveProcessEventHandler(AHandle);
+end;
+
+procedure RemovePipeEventHandler(AHandle: THandle);
+begin
+  WidgetSet.RemovePipeEventHandler(AHandle);
+end;
+
 function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean;
 // for Delphi compatibility a TBitmap has a Handle and a MaskHandle.
 // Some interfaces have only a combined Handle. To replace the mask use this

lcl/include/lclintfh.inc

@@ -38,6 +38,8 @@
 //##apiwiz##sps##    // Do not remove
 
 procedure AddEventHandler(AHandle: THandle; AFlags: dword; AEventHandler: TWaitHandleEvent; AData: PtrInt); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+procedure AddProcessEventHandler(AHandle: THandle; AEventHandler: TChildExitEvent; AData: PtrInt); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+procedure AddPipeEventHandler(AHandle: THandle; AEventHandler: TPipeEvent; AData: PtrInt); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 procedure AttachMenuToWindow(AMenuObject: TComponent); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
 procedure CallDefaultWndHandler(Sender: TObject; var Message); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@@ -106,6 +108,8 @@ function RadialPieWithAngles(DC: HDC; X,Y,Width,Height,Angle1,Angle2: Integer):
 function RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer;  {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 procedure RemoveEventHandler(AHandle: THandle); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+procedure RemoveProcessEventHandler(AHandle: THandle); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+procedure RemovePipeEventHandler(AHandle: THandle); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 

lcl/interfacebase.pp

@@ -37,8 +37,14 @@ uses
   GraphType, GraphMath;
 
 type
+  TChildExitReason = (cerExit, cerSignal);
+  TPipeReason = (prDataAvailable, prBroken, prCanWrite);
+  TPipeReasons = set of TPipeReason;
+
   TApplicationMainLoop = procedure of object;
   TWaitHandleEvent = procedure(AData: PtrInt; AFlags: dword) of object;
+  TChildExitEvent = procedure(AData: PtrInt; AReason: TChildExitReason; AInfo: dword) of object;
+  TPipeEvent = procedure(AData: PtrInt; AReasons: TPipeReasons) of object;
 
   { TWidgetSet }
 

lcl/interfaces/gtk/gtkint.pp

@@ -77,7 +77,7 @@ uses
   {$ENDIF}
   // Target OS specific
   {$IFDEF UNIX}
-  x, xlib,
+  x, xlib, ctypes, baseunix, unix,
   {$ENDIF}
   // LCL
   ExtDlgs, Dialogs, Controls, Forms, LCLStrConsts, LMessages,
@@ -114,6 +114,7 @@ type
     FStockWhitePen: HPEN;
 
     FWaitHandles: PWaitHandleEventHandler;
+    FChildSignalHandlers: PChildSignalEventHandler;
 
     {$Ifdef GTK2}
     FDefaultFontDesc: PPangoFontDescription;
@@ -130,6 +131,15 @@ type
     procedure FreeStockItems; virtual;
     procedure PassCmdLineOptions; override;
    
+{$ifdef UNIX}   
+    procedure InitSynchronizeSupport;
+    procedure ProcessChildSignal;
+    procedure PrepareSynchronize(AObject: TObject);
+{$endif}  
+
+    procedure HandlePipeEvent(AData: PtrInt; AFlags: dword);
+    function RemoveEventHandlerData(AHandle: THandle): PtrInt;
+
     // styles
     procedure FreeAllStyles; virtual;
     Function GetCompStyle(Sender : TObject) : Longint; Virtual;

lcl/interfaces/gtk/gtklclintf.inc

@@ -57,11 +57,12 @@ begin
   FWaitHandles := lEventHandler;
 end;
 
-procedure TGtkWidgetSet.RemoveEventHandler(AHandle: THandle);
+function TGtkWidgetSet.RemoveEventHandlerData(AHandle: THandle): PtrInt;
 var
   lEventHandler: PWaitHandleEventHandler;
   lPrevEventHandler: PPWaitHandleEventHandler;
 begin
+  Result := 0;
   lPrevEventHandler := @FWaitHandles;
   while lPrevEventHandler^ <> nil do
   begin
@@ -70,6 +71,7 @@ begin
     begin
       g_source_remove(lEventHandler^.GSourceID);
       lPrevEventHandler^ := lEventHandler^.NextHandler;
+      Result := lEventHandler^.UserData;
       Dispose(lEventHandler);
       exit;
     end;
@@ -77,6 +79,91 @@ begin
   end;
 end;
 
+procedure TGtkWidgetSet.RemoveEventHandler(AHandle: THandle);
+begin
+  RemoveEventHandlerData(AHandle);
+end;
+
+type
+  PPipeEventInfo = ^TPipeEventInfo;
+  TPipeEventInfo = record
+    Handle: THandle;
+    UserData: PtrInt;
+    OnEvent: TPipeEvent;
+  end;
+
+procedure TGtkWidgetSet.AddPipeEventHandler(AHandle: THandle; 
+  AEventHandler: TPipeEvent; AData: PtrInt);
+var
+  lPipeEventInfo: PPipeEventInfo;
+begin
+  if AEventHandler = nil then exit;
+  New(lPipeEventInfo);
+  lPipeEventInfo^.Handle := AHandle;
+  lPipeEventInfo^.UserData := AData;
+  lPipeEventInfo^.OnEvent := AEventHandler;
+  AddEventHandler(AHandle, G_IO_IN or G_IO_HUP or G_IO_OUT, 
+    @HandlePipeEvent, PtrInt(lPipeEventInfo));
+end;
+
+procedure TGtkWidgetSet.HandlePipeEvent(AData: PtrInt; AFlags: dword);
+var
+  lPipeEventInfo: PPipeEventInfo absolute AData;
+  lReasons: TPipeReasons;
+begin
+  lReasons := [];
+  if AFlags and G_IO_IN = G_IO_IN then
+    Include(lReasons, prDataAvailable);
+  if AFlags and G_IO_OUT = G_IO_OUT then
+    Include(lReasons, prCanWrite);
+  if AFlags and G_IO_HUP = G_IO_HUP then
+    Include(lReasons, prBroken);
+  
+  lPipeEventInfo^.OnEvent(lPipeEventInfo^.UserData, lReasons);
+end;
+
+procedure TGtkWidgetSet.RemovePipeEventHandler(AHandle: THandle);
+var
+  lPipeEventInfo: PPipeEventInfo;
+begin
+  lPipeEventInfo := PPipeEventInfo(RemoveEventHandlerData(AHandle));
+  if lPipeEventInfo <> nil then
+    Dispose(lPipeEventInfo);
+end;
+
+procedure TGtkWidgetSet.AddProcessEventHandler(AHandle: THandle;
+  AEventHandler: TChildExitEvent; AData: PtrInt);
+var  
+  lHandler: PChildSignalEventHandler;
+begin
+  if AEventHandler = nil then exit;
+  New(lHandler);
+  lHandler^.PID := TPid(AHandle);
+  lHandler^.UserData := AData;
+  lHandler^.OnEvent := AEventHandler;
+  lHandler^.NextHandler := FChildSignalHandlers;
+  FChildSignalHandlers := lHandler;
+end;
+
+procedure TGtkWidgetSet.RemoveProcessEventHandler(AHandle: THandle);
+var
+  lHandler: PChildSignalEventHandler;
+  lPrevHandler: PPChildSignalEventHandler;
+begin
+  lPrevHandler := @FChildSignalHandlers;
+  while lPrevHandler^ <> nil do
+  begin
+    lHandler := lPrevHandler^;
+    if lHandler^.PID = TPid(AHandle) then
+    begin
+      lPrevHandler^ := lHandler^.NextHandler;
+      Dispose(lHandler);
+      exit;
+    end;
+    lPrevHandler := @lHandler^.NextHandler;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   function TGtkWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
     Horizontal: boolean): Integer;

lcl/interfaces/gtk/gtklclintfh.inc

@@ -31,6 +31,10 @@
 //##apiwiz##sps##   // Do not remove
 procedure AddEventHandler(AHandle: THandle; AFlags: dword; 
   AEventHandler: TWaitHandleEvent; AData: PtrInt); override;
+procedure AddPipeEventHandler(AHandle: THandle;
+  AEventHandler: TPipeEvent; AData: PtrInt); override;
+procedure AddProcessEventHandler(AHandle: THandle;
+  AEventHandler: TChildExitEvent; AData: PtrInt); override;
 function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; override;
 
 function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
@@ -47,6 +51,8 @@ function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRec
 function IntfSendsUTF8KeyPress: boolean; override;
 
 procedure RemoveEventHandler(AHandle: THandle); override;
+procedure RemovePipeEventHandler(AHandle: THandle); override;
+procedure RemoveProcessEventHandler(AHandle: THandle); override;
 function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; override;
 
 //##apiwiz##eps##   // Do not remove, no wizard declaration after this line

lcl/interfaces/gtk/gtkobject.inc

@@ -129,6 +129,31 @@ begin
 
 end;
 
+{$ifdef UNIX}
+
+// TThread.Synchronize support
+var
+  threadsync_pipein, threadsync_pipeout: cint;
+  threadsync_giochannel: pgiochannel;
+  childsig_pending: boolean;
+
+procedure ChildEventHandler(sig: longint; siginfo: psiginfo; sigcontext: psigcontext); cdecl;
+begin
+  childsig_pending := true;
+  WakeMainThread(nil);
+end;
+
+procedure InstallSignalHandler;
+var
+  child_action: sigactionrec;
+begin
+  child_action.sa_handler := @ChildEventHandler;
+  fpsigemptyset(child_action.sa_mask);
+  child_action.sa_flags := 0;
+  fpsigaction(SIGCHLD, @child_action, nil);
+end;
+
+{$endif}
 
 {------------------------------------------------------------------------------
   Method: TGtkWidgetSet.Create
@@ -206,6 +231,11 @@ begin
   ClipboardTypeAtoms[ctSecondarySelection]:=GDK_SELECTION_SECONDARY;
   ClipboardTypeAtoms[ctClipboard]:=gdk_atom_intern('CLIPBOARD',GdkFalse);
 
+  InitSynchronizeSupport;
+{$ifdef UNIX}
+  InstallSignalHandler;
+{$endif}
+
   GTKWidgetSet := Self;
 end;
 
@@ -481,10 +511,92 @@ begin
   g_log_remove_handler(nil, FLogHandlerID);
 
   GTKWidgetSet := nil;
+  WakeMainThread := nil;
 
   inherited Destroy;
 end;
 
+{$ifdef UNIX}
+
+procedure TGtkWidgetSet.PrepareSynchronize(AObject: TObject);
+begin
+  // wake up GUI thread by send a byte through the threadsync pipe
+  fpwrite(threadsync_pipeout, ' ', 1);
+end;
+
+procedure TGtkWidgetSet.ProcessChildSignal;
+var
+  pid: tpid;
+  reason: TChildExitReason;
+  status: integer;
+  info: dword;
+  handler: PChildSignalEventHandler;
+begin
+  repeat
+    pid := fpwaitpid(-1, status, WNOHANG);
+    if pid <= 0 then break;
+    if wifexited(status) then
+    begin
+      reason := cerExit;
+      info := wexitstatus(status);
+    end else
+    if wifsignaled(status) then
+    begin
+      reason := cerSignal;
+      info := wtermsig(status);
+    end else
+      continue;
+   
+    handler := FChildSignalHandlers;
+    while handler <> nil do
+    begin
+      if handler^.pid = pid then
+      begin
+        handler^.OnEvent(handler^.UserData, reason, info);
+        break;
+      end;
+      handler := handler^.NextHandler;
+    end;
+  until false;
+end;
+
+function threadsync_iocallback(source: PGIOChannel; condition: TGIOCondition; 
+  data: gpointer): gboolean; cdecl;
+var
+  thrashspace: char;
+begin
+  // read the sent byte
+  fpread(threadsync_pipein, thrashspace, 1);
+  Result := true;
+  // one of children signaled ?
+  if childsig_pending then
+  begin
+    childsig_pending := false;
+    TGtkWidgetSet(data).ProcessChildSignal;
+  end;
+  // execute the to-be synchronized method
+  CheckSynchronize;
+end;
+
+procedure TGtkWidgetSet.InitSynchronizeSupport;
+begin
+  { TThread.Synchronize ``glue'' }
+  WakeMainThread := @PrepareSynchronize;
+  assignpipe(threadsync_pipein, threadsync_pipeout);
+  threadsync_giochannel := g_io_channel_unix_new(threadsync_pipein);
+  g_io_add_watch(threadsync_giochannel, G_IO_IN, @threadsync_iocallback, nil);
+end;
+
+{$else}
+
+{$message warn TThread.Synchronize will not work on Gtk/Win32 }
+
+procedure InitSynchronizeSupport;
+begin
+end;
+
+{$endif}
+
 {------------------------------------------------------------------------------
   Method: TGtkWidgetSet.SetWindowSizeAndPosition
   Params:  Widget: PGtkWidget; AWinControl: TWinControl

lcl/interfaces/gtk/gtkproc.pp

@@ -69,6 +69,18 @@ type
     NextHandler: PWaitHandleEventHandler;
   end;
 
+{$ifdef UNIX}
+  PPChildSignalEventHandler = ^PChildSignalEventHandler;
+  PChildSignalEventHandler = ^TChildSignalEventHandler;
+  TChildSignalEventHandler = record
+    PID: TPid;
+    UserData: PtrInt;
+    OnEvent: TChildExitEvent;
+    NextHandler: PChildSignalEventHandler;
+  end;
+    
+{$endif}
+
 {$IFDEF gtk2}
 const
   gdkdll = gdklib;
@@ -991,39 +1003,9 @@ end;
 {$I gtkproc.inc}
 {$I gtkcallback.inc}
 
-// TThread.Synchronize support
-var
-  threadsync_pipein, threadsync_pipeout: cint;
-  threadsync_giochannel: pgiochannel;
-
-type
-  TSynchronizeGlue = class(TObject)
-  public
-    procedure PrepareSynchronize(AObject: TObject);
-  end;
-  
-procedure TSynchronizeGlue.PrepareSynchronize(AObject: TObject);
-begin
-  // wake up GUI thread by send a byte through the threadsync pipe
-  fpwrite(threadsync_pipeout, ' ', 1);
-end;
-
-function threadsync_iocallback(source: PGIOChannel; condition: TGIOCondition; 
-  data: gpointer): gboolean; cdecl;
-var
-  thrashspace: char;
-begin
-  // read the sent byte
-  fpread(threadsync_pipein, thrashspace, 1);
-  // execute the to-be synchronized method
-  CheckSynchronize;
-  Result := true;
-end;
-
 procedure InitGTKProc;
 var
   lgs: TLazGtkStyle;
-  needInstancePtr: TSynchronizeGlue;
 begin
 
   FillChar(MCharToVK, SizeOf(MCharToVK), $FF);
@@ -1039,19 +1021,11 @@ begin
 
   for lgs:=Low(TLazGtkStyle) to High(TLazGtkStyle) do
     StandardStyles[lgs]:=nil;
-
-  { TThread.Synchronize ``glue'' }
-  WakeMainThread := @needInstancePtr.PrepareSynchronize;
-  assignpipe(threadsync_pipein, threadsync_pipeout);
-  threadsync_giochannel := g_io_channel_unix_new(threadsync_pipein);
-  g_io_add_watch(threadsync_giochannel, G_IO_IN, @threadsync_iocallback, nil);
 end;
 
 procedure DoneGTKProc;
 begin
   DoneKeyboardTables;
-
-  WakeMainThread := nil;
 end;
 
 {$IFDEF GTK1}

lcl/interfaces/win32/win32int.pp

@@ -106,6 +106,15 @@ Type
     OnEvent: TWaitHandleEvent;
   end;
 
+  PPPipeEventHandler = ^PPipeEventHandler;
+  PPipeEventHandler = ^TPipeEventHandler;
+  TPipeEventHandler = record
+    Handle: THandle;
+    UserData: PtrInt;
+    OnEvent: TPipeEvent;
+    NextHandler: PPipeEventHandler;
+  end;
+
   { Win32 interface-object class }
   TWin32WidgetSet = Class(TWidgetSet)
   Private
@@ -130,6 +139,7 @@ Type
     FWaitHandleCount: dword;
     FWaitHandles: array of HANDLE;
     FWaitHandlers: array of TWaitHandler;
+    FWaitPipeHandlers: PPipeEventHandler;
 
     FThemesActive: boolean;
     FThemeLibrary: HMODULE;
@@ -145,6 +155,11 @@ Type
     procedure FillRawImageDescription(const BitmapInfo: Windows.TBitmap;
         Desc: PRawImageDescription);
 
+    { event handler helper functions }
+    procedure HandleProcessEvent(AData: PtrInt; AFlags: dword);
+    function  RemoveEventHandlerData(AHandle: THandle): PtrInt;
+    procedure CheckPipeEvents;
+
     Function WinRegister: Boolean;
     Procedure NormalizeIconName(Var IconName: String);
     Procedure NormalizeIconName(Var IconName: PChar);

lcl/interfaces/win32/win32lclintf.inc

@@ -47,13 +47,15 @@ begin
   Inc(FWaitHandleCount);
 end;
 
-procedure TWin32WidgetSet.RemoveEventHandler(AHandle: THandle);
+function TWin32WidgetSet.RemoveEventHandlerData(AHandle: THandle): PtrInt;
 var
   I: integer;
 begin
+  Result := 0;
   for I := 0 to FWaitHandleCount - 1 do
     if FWaitHandles[I] = AHandle then
     begin
+      Result := FWaitHandlers[I].UserData;
       // swap with last one
       if FWaitHandleCount >= 2 then
       begin
@@ -65,6 +67,84 @@ begin
     end;
 end;
 
+procedure TWin32WidgetSet.RemoveEventHandler(AHandle: THandle);
+begin
+  RemoveEventHandlerData(AHandle);
+end;
+
+procedure TWin32WidgetSet.AddPipeEventHandler(AHandle: THandle; 
+  AEventHandler: TPipeEvent; AData: PtrInt);
+var
+  lHandler: PPipeEventHandler;
+begin
+  if AEventHandler = nil then exit;
+  New(lHandler);
+  lHandler^.Handle := AHandle;
+  lHandler^.UserData := AData;
+  lHandler^.OnEvent := AEventHandler;
+  lHandler^.NextHandler := FWaitPipeHandlers;
+  FWaitPipeHandlers := lHandler;
+end;
+
+procedure TWin32WidgetSet.RemovePipeEventHandler(AHandle: THandle);
+var
+  lPrevHandler: PPPipeEventHandler;
+  lHandler: PPipeEventHandler;
+begin
+  lPrevHandler := @FWaitPipeHandlers;
+  while lPrevHandler^ <> nil do
+  begin
+    lHandler := lPrevHandler^;
+    if lHandler^.Handle = AHandle then
+    begin
+      lPrevHandler^ := lHandler^.NextHandler;
+      Dispose(lHandler);
+      exit;
+    end;
+    lPrevHandler := @lHandler^.NextHandler;
+  end;
+end;
+
+type
+  PProcessEvent = ^TProcessEvent;
+  TProcessEvent = record
+    Handle: THandle;
+    UserData: PtrInt;
+    OnEvent: TChildExitEvent;
+  end;
+
+procedure TWin32WidgetSet.AddProcessEventHandler(AHandle: THandle;
+  AEventHandler: TChildExitEvent; AData: PtrInt);
+var
+  lProcessEvent: PProcessEvent;
+begin
+  if AEventHandler = nil then exit;
+  New(lProcessEvent);
+  lProcessEvent^.Handle := AHandle;
+  lProcessEvent^.UserData := AData;
+  lProcessEvent^.OnEvent := AEventHandler;
+  AddEventHandler(AHandle, 0, @HandleProcessEvent, PtrInt(lProcessEvent));
+end;
+
+procedure TWin32WidgetSet.HandleProcessEvent(AData: PtrInt; AFlags: dword);
+var
+  lProcessEvent: PProcessEvent absolute AData;
+  exitcode: dword;
+begin
+  if not Windows.GetExitCodeProcess(lProcessEvent^.Handle, exitcode) then
+    exitcode := 0;
+  lProcessEvent^.OnEvent(lProcessEvent^.UserData, cerExit, exitcode);
+end;
+
+procedure TWin32WidgetSet.RemoveProcessEventHandler(AHandle: THandle);
+var
+  lProcessEvent: PProcessEvent;
+begin
+  lProcessEvent := PProcessEvent(RemoveEventHandlerData(AHandle));
+  if lProcessEvent <> nil then
+    Dispose(lProcessEvent);
+end;
+
 procedure TWin32WidgetSet.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
 const
     { up, down, left, right }

lcl/interfaces/win32/win32lclintfh.inc

@@ -31,6 +31,10 @@
 
 procedure AddEventHandler(AHandle: THandle; AFlags: dword; 
   AEventHandler: TWaitHandleEvent; AData: PtrInt); override;
+procedure AddPipeEventHandler(AHandle: THandle; 
+  AEventHandler: TPipeEvent; AData: PtrInt); override;
+procedure AddProcessEventHandler(AHandle: THandle;
+  AEventHandler: TChildExitEvent; AData: PtrInt); override;
   
 procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
 
@@ -39,6 +43,8 @@ function GetControlConstraints(Constraints: TObject): boolean; override;
 function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
 
 procedure RemoveEventHandler(AHandle: THandle); override;
+procedure RemovePipeEventHandler(AHandle: THandle); override;
+procedure RemoveProcessEventHandler(AHandle: THandle); override;
 
 
 //##apiwiz##eps##   // Do not remove, no wizard declaration after this line

lcl/interfaces/win32/win32object.inc

@@ -314,6 +314,24 @@ Begin
   End;
 End;
 
+procedure TWin32WidgetSet.CheckPipeEvents;
+var
+  lHandler: PPipeEventHandler;
+  lBytesAvail: dword;
+begin
+  lHandler := FWaitPipeHandlers;
+  while lHandler <> nil do
+  begin
+    if PeekNamedPipe(lHandler^.Handle, nil, 0, nil, @lBytesAvail, nil) then
+    begin
+      if lBytesAvail <> 0 then
+        lHandler^.OnEvent(lHandler^.UserData, [prDataAvailable]);
+    end else
+      lHandler^.OnEvent(lHandler^.UserData, [prBroken]);
+    lHandler := lHandler^.NextHandler;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method: TWin32WidgetSet.AppWaitMessage
   Params:  None
@@ -325,18 +343,28 @@ procedure TWin32WidgetSet.AppWaitMessage;
 var
   done: boolean;
   retVal, index: dword;
+  timeout: dword;
 begin
   RedrawMenus;
   Assert(False, 'Trace:TWin32WidgetSet.WaitMessage - Start');
   done := false;
   repeat
+    if FWaitPipeHandlers <> nil then
+      timeout := 100
+    else
+      timeout := INFINITE;
     retVal := Windows.MsgWaitForMultipleObjects(FWaitHandleCount, 
-      FWaitHandles[0], false, INFINITE, QS_ALLINPUT);
+      FWaitHandles[0], false, timeout, QS_ALLINPUT);
     if (WAIT_OBJECT_0 <= retVal) and (retVal < WAIT_OBJECT_0 + FWaitHandleCount) then
     begin
       index := retVal-WAIT_OBJECT_0;
       FWaitHandlers[index].OnEvent(FWaitHandlers[index].UserData, 0);
-    end else if retVal = WAIT_OBJECT_0 + FWaitHandleCount then
+    end else
+    if retVal = WAIT_TIMEOUT then
+    begin
+      CheckPipeEvents;
+    end else 
+    if retVal = WAIT_OBJECT_0 + FWaitHandleCount then
       done := true;
   until done;
   Assert(False,'Trace:Leave wait message');