started using TAsyncProceess, fixed gtk2 compilation

git-svn-id: trunk@8290 -

ide/compiler.pp

@@ -39,8 +39,8 @@ unit Compiler;
 interface
 
 uses
-  Classes, SysUtils, LCLProc, Forms, Controls, CompilerOptions, Project,
-  Process, LazarusIDEStrConsts, IDEProcs, OutputFilter, FileUtil;
+  Classes, SysUtils, Process, LCLProc, Forms, Controls, FileUtil, AsyncProcess,
+  LazarusIDEStrConsts, CompilerOptions, Project, IDEProcs, OutputFilter;
 
 type
   TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean)
@@ -52,16 +52,18 @@ type
   private
     FOnCmdLineCreate : TOnCmdLineCreate;
     FOutputFilter: TOutputFilter;
+    FTheProcess: TProcess;
   public
     constructor Create;
     destructor Destroy; override;
     function Compile(AProject: TProject; BuildAll: boolean;
-      const WorkingDir, CompilerFilename, CompilerParams: string): TModalResult;
+                     const WorkingDir, CompilerFilename, CompilerParams: string
+                     ): TModalResult;
     procedure WriteError(const Msg: string);
-    property OnCommandLineCreate: TOnCmdLineCreate
-      read FOnCmdLineCreate write FOnCmdLineCreate;
-    property OutputFilter: TOutputFilter
-      read FOutputFilter write FOutputFilter;
+    property OnCommandLineCreate: TOnCmdLineCreate read FOnCmdLineCreate
+                                                   write FOnCmdLineCreate;
+    property OutputFilter: TOutputFilter read FOutputFilter write FOutputFilter;
+    property TheProcess: TProcess read FTheProcess;
   end;
 
 
@@ -83,6 +85,7 @@ end;
 {------------------------------------------------------------------------------}
 destructor TCompiler.Destroy;
 begin
+  FreeAndNil(FTheProcess);
   inherited Destroy;
 end;
 
@@ -95,7 +98,6 @@ var
   CmdLine : String;
   Abort : Boolean;
   OldCurDir: string;
-  TheProcess : TProcess;
 begin
   Result:=mrCancel;
   DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
@@ -143,7 +145,13 @@ begin
     DebugLn('[TCompiler.Compile] CmdLine="',CmdLine,'"');
 
     try
-      TheProcess := TProcess.Create(nil);
+      if TheProcess=nil then begin
+        {$IFDEF UseAsyncProcess}
+        FTheProcess := TAsyncProcess.Create(nil);
+        {$ELSE}
+        FTheProcess := TProcess.Create(nil);
+        {$ENDIF}
+      end;
       TheProcess.CommandLine := CmdLine;
       TheProcess.Options:= [poUsePipes, poStdErrToOutput];
       TheProcess.ShowWindow := swoHide;
@@ -160,7 +168,6 @@ begin
         end;
       finally
         TheProcess.WaitOnExit;
-        TheProcess.Free;
       end;
     except
       on e: EOutputFilterError do begin

ide/exttooldialog.pas

@@ -40,7 +40,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, SysUtils, LCLType, LCLProc, Controls, Forms, Buttons, StdCtrls,
-  ComCtrls, Dialogs, LResources, Laz_XMLCfg,
+  ComCtrls, Dialogs, LResources, Laz_XMLCfg, AsyncProcess,
   ExtToolEditDlg, Process, IDECommands, KeyMapping, TransferMacros, IDEProcs,
   CompilerOptions, OutputFilter, FileUtil, LazarusIDEStrConsts;
 
@@ -294,7 +294,11 @@ begin
   DebugLn('[TExternalToolList.Run] CmdLine="',CmdLine,'" WorkDir="',WorkingDir,'"');
   try
     CheckIfFileIsExecutable(Filename);
+    {$IFDEF UseAsyncProcess}
+    TheProcess := TAsyncProcess.Create(nil);
+    {$ELSE}
     TheProcess := TProcess.Create(nil);
+    {$ENDIF}
     TheProcess.CommandLine := Filename+' '+Params;
     TheProcess.Options:= [poUsePipes,poStdErrToOutPut];
     TheProcess.ShowWindow := swoHide;

ide/main.pp

@@ -7428,7 +7428,9 @@ begin
     Result:=mrCancel;
     exit;
   end;
+
   MessagesView.BeginBlock;
+
   try
     // first compile all lazarus components (LCL, SynEdit, CodeTools, ...)
     SourceNotebook.ClearErrorLines;

ide/outputfilter.pas

@@ -28,7 +28,7 @@ interface
 
 uses
   Classes, SysUtils, Forms, Controls, CompilerOptions, Project, Process,
-  IDEProcs, FileUtil, LclProc, LazConf;
+  IDEProcs, FileUtil, LclProc, LazConf, AsyncProcess;
 
 type
   TOnOutputString = procedure(const Msg, Directory: String) of object;
@@ -119,6 +119,8 @@ type
 
   TOutputFilter = class
   private
+    FAsyncDataAvailable: boolean;
+    FAsyncProcessTerminated: boolean;
     FCompilerOptions: TBaseCompilerOptions;
     FBufferingOutputLock: integer;
     fCurrentDirectory: string;
@@ -144,6 +146,8 @@ type
     function SearchIncludeFile(const ShortIncFilename: string): string;
     procedure SetStopExecute(const AValue: boolean);
     procedure InternalSetCurrentDirectory(const Dir: string);
+    procedure OnAsyncTerminate(Sender: TObject);
+    procedure OnAsyncReadData(Sender: TObject);
   public
     ErrorExists: boolean;
     Aborted: boolean;
@@ -179,6 +183,7 @@ type
     property CompilerOptions: TBaseCompilerOptions read FCompilerOptions
                                                write FCompilerOptions;
     property CurrentMessageParts: TOutputLine read GetCurrentMessageParts;
+    property AsyncProcessTerminated: boolean read FAsyncProcessTerminated;
   end;
   
   EOutputFilterError = class(Exception)
@@ -218,6 +223,8 @@ end;
 procedure TOutputFilter.Clear;
 begin
   fOutput.Clear;
+  FAsyncDataAvailable:=false;
+  FAsyncProcessTerminated:=false;
   FLastOutputLine:=-1;
   fFilteredOutput.Clear;
   if fCompilingHistory<>nil then fCompilingHistory.Clear;
@@ -233,11 +240,12 @@ const
 var
   i, Count, LineStart : longint;
   OutputLine, Buf : String;
+  TheAsyncProcess: TAsyncProcess;
+  
 begin
   Result:=true;
   Clear;
   //debugln('TOutputFilter.Execute A CurrentDirectory="',TheProcess.CurrentDirectory,'"');
-  TheProcess.Execute;
   fCurrentDirectory:=TrimFilename(TheProcess.CurrentDirectory);
   if fCurrentDirectory='' then fCurrentDirectory:=GetCurrentDir;
   fCurrentDirectory:=AppendPathDelim(fCurrentDirectory);
@@ -248,6 +256,15 @@ begin
   Aborted:=false;
   try
     BeginBufferingOutput;
+    
+    if TheProcess is TAsyncProcess then begin
+      TheAsyncProcess:=TAsyncProcess(TheProcess);
+      TheAsyncProcess.OnReadData:=@OnAsyncReadData;
+      TheAsyncProcess.OnTerminate:=@OnAsyncTerminate;
+    end else
+      TheAsyncProcess:=nil;
+
+    TheProcess.Execute;
     repeat
       Application.ProcessMessages;
       if StopExecute then begin
@@ -258,10 +275,23 @@ begin
         break;
       end;
 
-      if TheProcess.Output<>nil then
-        Count:=TheProcess.Output.Read(Buf[1],length(Buf))
-      else
-        Count:=0;
+      Count:=0;
+      if (TheAsyncProcess<>nil) then begin
+        Count:=TheAsyncProcess.NumBytesAvailable;
+        if (Count=0) and AsyncProcessTerminated then break;
+      end;
+      if (TheAsyncProcess=nil) and (TheProcess.Output<>nil) then begin
+        // using a blocking TProcess
+        Count:=TheProcess.Output.Read(Buf[1],length(Buf));
+        if Count=0 then begin
+          // no output on blocking means, process has ended
+          break;
+        end;
+      end;
+      {$IFDEF UseAsyncProcess}
+      DebugLn('TOutputFilter.Execute Count=',dbgs(Count));
+      {$ENDIF}
+
       LineStart:=1;
       i:=1;
       while i<=Count do begin
@@ -280,8 +310,14 @@ begin
         inc(i);
       end;
       OutputLine:=OutputLine+copy(Buf,LineStart,Count-LineStart+1);
-    until Count=0;
+    until false;
+    {$IFDEF UseAsyncProcess}
+    DebugLn('TOutputFilter.Execute After Loop');
+    {$ENDIF}
     TheProcess.WaitOnExit;
+    {$IFDEF UseAsyncProcess}
+    DebugLn('TOutputFilter.Execute TheProcess.ExitStatus=',dbgs(TheProcess.ExitStatus));
+    {$ENDIF}
     if TheProcess.ExitStatus=0 then
       ErrorExists:=false;
     if ErrorExists and (ofoExceptionOnError in Options) then
@@ -946,6 +982,16 @@ begin
   fCurrentDirectory:=TrimFilename(AppendPathDelim(SetDirSeparators(Dir)));
 end;
 
+procedure TOutputFilter.OnAsyncTerminate(Sender: TObject);
+begin
+  FAsyncProcessTerminated:=true;
+end;
+
+procedure TOutputFilter.OnAsyncReadData(Sender: TObject);
+begin
+  FAsyncDataAvailable:=true;
+end;
+
 destructor TOutputFilter.Destroy;
 begin
   fFilteredOutput.Free;

ide/uniteditor.pp

@@ -2291,8 +2291,7 @@ end;
 Procedure TSourceEditor.EditorKeyDown(Sender: TObject; var Key: Word; Shift :
   TShiftState);
 begin
-  DebugLn('TSourceEditor.EditorKeyDown A ',TComponent(Sender).Name,
-    ':',ClassName,' ',IntToStr(Key));
+  //DebugLn('TSourceEditor.EditorKeyDown A ',dbgsName(Sender),' ',IntToStr(Key));
   if Assigned(OnKeyDown) then
     OnKeyDown(Sender, Key, Shift);
 end;

lcl/grids.pas

@@ -4228,8 +4228,9 @@ end;
 procedure TCustomGrid.DoEditorHide;
 begin
   Editor.Visible:=False;
-  //Editor.Parent:=nil;
-  LCLIntf.SetFocus(Self.Handle);
+  if HandleAllocated
+  and ([csLoading,csDesigning,csDestroying]*ComponentState=[]) then
+    LCLIntf.SetFocus(Handle);
 end;
 
 procedure TCustomGrid.DoEditorShow;

lcl/interfaces/gtk2/gtk2int.pas

@@ -121,7 +121,7 @@ type
     property Owner: TWinControl read FOwner;
   end;
 
-{$IfDef GTK2}
+{$IfDef GTK2_2}
 procedure gdk_display_get_pointer(display : PGdkDisplay; screen :PGdkScreen; x :Pgint; y : Pgint; mask : PGdkModifierType); cdecl; external gdklib;
 function gdk_display_get_default:PGdkDisplay; cdecl; external gdklib;
 
@@ -140,7 +140,7 @@ uses
 ////////////////////////////////////////////////////
 // I M P O R T A N T
 ////////////////////////////////////////////////////
-// To get as litle as posible circles,
+// To get as litle as possible circles,
 // uncomment only those units with implementation
 ////////////////////////////////////////////////////
 // Gtk2WSActnList,

lcl/widgetset/wscontrols.pp

@@ -195,6 +195,7 @@ end;
 
 procedure TWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer);
 begin
+
 end;
     
 procedure TWSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);