unit ExtToolsConsole; {$mode objfpc}{$H+} interface uses Classes, SysUtils, // LazUtils LazLogger, LazUtilities, // IDEIntf IDEExternToolIntf, // IDE ExtTools; type { TLazExtToolConsoleView } TLazExtToolConsoleView = class(TLazExtToolView) protected fWrittenLineCount: integer; procedure ToolExited; override; // (main thread) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure InputClosed; override; // (main thread) procedure ProcessNewMessages({%H-}AThread: TThread); override; // (worker thread, Tool is in Critical section) procedure OnNewOutput(Sender: TObject; {%H-}FirstNewMsgLine: integer); // (main thread) end; { TLazExtToolConsole } TLazExtToolConsole = class(TComponent) private fViews: TFPList; // list of TLazExtToolConsoleView function GetViews(Index: integer): TLazExtToolConsoleView; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; function FindUnfinishedView: TLazExtToolConsoleView; property Views[Index: integer]: TLazExtToolConsoleView read GetViews; function Count: integer; inline; end; { TExternalToolConsole } TExternalToolConsole = class(TExternalTool) protected procedure CreateView; override; procedure QueueAsyncAutoFree; override; public end; { TExternalToolsConsole } TExternalToolsConsole = class(TExternalTools) public constructor Create(aOwner: TComponent); override; destructor Destroy; override; function GetIDEObject({%H-}ToolData: TIDEExternalToolData): TObject; override; procedure HandleMessages; override; end; var ExtToolConsole: TLazExtToolConsole = nil; // set by lazbuild implementation { TLazExtToolConsoleView } constructor TLazExtToolConsoleView.Create(AOwner: TComponent); begin inherited Create(AOwner); end; destructor TLazExtToolConsoleView.Destroy; begin Assert(Owner is TLazExtToolConsole, 'TLazExtToolConsoleView.Destroy: Owner is not TLazExtToolConsole.'); TLazExtToolConsole(Owner).fViews.Remove(Self); inherited Destroy; end; procedure TLazExtToolConsoleView.ToolExited; begin inherited ToolExited; if Tool.Terminated then begin ToolState:=lmvtsFailed; debugln('Error: (lazarus) ',Caption,': terminated'); end else if (ExitCode<>0) then begin ToolState:=lmvtsFailed; debugln('Error: (lazarus) ',Caption,': stopped with exit code '+IntToStr(ExitCode)); end else if (ExitStatus<>0) then begin ToolState:=lmvtsFailed; debugln('Error: (lazarus) ',Caption,': stopped with exit status '+IntToStr(ExitStatus)); end else if Tool.ErrorMessage<>'' then begin ToolState:=lmvtsFailed; debugln('Error: (lazarus) ',Caption,': ',Tool.ErrorMessage); end else begin ToolState:=lmvtsSuccess; end; end; procedure TLazExtToolConsoleView.ProcessNewMessages(AThread: TThread); begin end; procedure TLazExtToolConsoleView.OnNewOutput(Sender: TObject; FirstNewMsgLine: integer); begin while fWrittenLineCountnil do begin CheckSynchronize; Sleep(10); end; for i:=Count-1 downto 0 do begin if i>=Count then continue; Views[i].Free; end; if Count>0 then raise Exception.Create('TLazExtToolConsole.Clear: some views failed to free'); end; function TLazExtToolConsole.FindUnfinishedView: TLazExtToolConsoleView; var i: Integer; begin for i:=0 to fViews.Count-1 do begin Result:=Views[i]; if not Result.HasFinished then exit; end; Result:=nil; end; { TExternalToolConsole } procedure TExternalToolConsole.CreateView; // in console mode all output goes unparsed to console var View: TLazExtToolConsoleView; begin if ViewCount>0 then exit; ClearParsers; //View := ExtToolConsole.CreateView(Self); View := TLazExtToolConsoleView.Create(ExtToolConsole); View.Caption:=Self.Title; AddHandlerOnNewOutput(@View.OnNewOutput); ExtToolConsole.fViews.Add(View); // ToDo: Eliminate ExtToolConsole. AddView(View); end; procedure TExternalToolConsole.QueueAsyncAutoFree; begin DebugLn(['WARNING: TExternalTool.SetThread can not call AutoFree from other thread']); end; { TExternalToolsConsole } constructor TExternalToolsConsole.Create(aOwner: TComponent); begin inherited Create(aOwner); FToolClass := TExternalToolConsole; end; destructor TExternalToolsConsole.Destroy; begin inherited Destroy; end; function TExternalToolsConsole.GetIDEObject(ToolData: TIDEExternalToolData): TObject; begin raise Exception.Create('TExternalToolsConsole.GetIDEObject: Should not happen!'); Result:=nil; end; procedure TExternalToolsConsole.HandleMessages; begin if IsMultiThread then begin if ConsoleVerbosity>0 then DebugLn('TExternalToolsConsole.HandleMessages: Calling CheckSynchronize.'); CheckSynchronize; end; end; end.