paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 21:41:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: clean up

Browse Source 
git-svn-id: trunk@42287 -
This commit is contained in:
mattias 2013-08-03 15:20:09 +00:00
parent fff8bce9a0
commit ef6d94035e
1 changed files with 5 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
ide/compiler.pp
View File

@ -49,53 +49,25 @@ uses
type type
TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean) of object; TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean) of object;
{$IFDEF WithAsyncCompile}
TBuildProjectData = class
public
Reason: TCompileReason;
Flags: TProjectBuildFlags;
CompilerFilename: String;
CompilerParams: String;
end;
{$ENDIF}
{ TCompiler } { TCompiler }
TCompiler = class(TObject) TCompiler = class(TObject)
private private
{$IFDEF WithAsyncCompile}
FASyncResult: TModalResult;
{$ENDIF}
FOnCmdLineCreate : TOnCmdLineCreate; FOnCmdLineCreate : TOnCmdLineCreate;
FOutputFilter: TOutputFilter; FOutputFilter: TOutputFilter;
FTheProcess: TProcessUTF8; FTheProcess: TProcessUTF8;
{$IFDEF WithAsyncCompile}
FFinishedCallback: TNotifyEvent;
procedure CompilationFinished(Sender: TObject);
{$ENDIF}
{$IFDEF WithAsyncCompile}
public
// Values stored by caller, to be rtrieved on callback
CallerData: TObject;
{$ENDIF}
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
function Compile(AProject: TProject; function Compile(AProject: TProject;
const WorkingDir, CompilerFilename, CompilerParams: string; const WorkingDir, CompilerFilename, CompilerParams: string;
BuildAll, SkipLinking, SkipAssembler: boolean BuildAll, SkipLinking, SkipAssembler: boolean
{$IFDEF WithAsyncCompile}
; aFinishedCallback: TNotifyEvent = nil
{$ENDIF}
): TModalResult; ): TModalResult;
procedure WriteError(const Msg: string); procedure WriteError(const Msg: string);
property OnCommandLineCreate: TOnCmdLineCreate read FOnCmdLineCreate property OnCommandLineCreate: TOnCmdLineCreate read FOnCmdLineCreate
write FOnCmdLineCreate; write FOnCmdLineCreate;
property OutputFilter: TOutputFilter read FOutputFilter write FOutputFilter; property OutputFilter: TOutputFilter read FOutputFilter write FOutputFilter;
property TheProcess: TProcessUTF8 read FTheProcess; property TheProcess: TProcessUTF8 read FTheProcess;
{$IFDEF WithAsyncCompile}
property ASyncResult: TModalResult read FASyncResult;
{$ENDIF}
end; end;
// Following classes are for compiler options parsed from "fpc -h" and "fpc -i". // Following classes are for compiler options parsed from "fpc -h" and "fpc -i".
@ -249,17 +221,12 @@ end;
function TCompiler.Compile(AProject: TProject; function TCompiler.Compile(AProject: TProject;
const WorkingDir, CompilerFilename, CompilerParams: string; const WorkingDir, CompilerFilename, CompilerParams: string;
BuildAll, SkipLinking, SkipAssembler: boolean BuildAll, SkipLinking, SkipAssembler: boolean
{$IFDEF WithAsyncCompile} ; aFinishedCallback: TNotifyEvent = nil {$ENDIF}
): TModalResult; ): TModalResult;
var var
CmdLine : String; CmdLine : String;
Abort : Boolean; Abort : Boolean;
begin begin
Result:=mrCancel; Result:=mrCancel;
{$IFDEF WithAsyncCompile}
FASyncResult:= mrNone;
FFinishedCallback := aFinishedCallback;
{$ENDIF}
if ConsoleVerbosity>=0 then if ConsoleVerbosity>=0 then
DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"'); DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
@ -323,24 +290,16 @@ begin
WorkingDir, -1); WorkingDir, -1);
OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError]; OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError];
OutputFilter.CompilerOptions:=AProject.CompilerOptions; OutputFilter.CompilerOptions:=AProject.CompilerOptions;
{$IFDEF WithAsyncCompile} if not OutputFilter.Execute(TheProcess,Self) then
if aFinishedCallback <> nil then if OutputFilter.Aborted then
begin Result := mrAbort
OutputFilter.ExecuteAsyncron(TheProcess, @CompilationFinished, Self); else
end Result := mrCancel;
else
{$ENDIF}
if not OutputFilter.Execute(TheProcess,Self) then
if OutputFilter.Aborted then
Result := mrAbort
else
Result := mrCancel;
end else begin end else begin
TheProcess.Execute; TheProcess.Execute;
end; end;
finally finally
if TheProcess.Running if TheProcess.Running
{$IFDEF WithAsyncCompile} and ((OutputFilter = nil) or (aFinishedCallback = nil)) {$ENDIF}
then begin then begin
TheProcess.WaitOnExit; TheProcess.WaitOnExit;
if not (TheProcess.ExitStatus in [0,1]) then begin if not (TheProcess.ExitStatus in [0,1]) then begin
@ -366,29 +325,6 @@ begin
DebugLn('[TCompiler.Compile] end'); DebugLn('[TCompiler.Compile] end');
end; end;
{$IFDEF WithAsyncCompile}
procedure TCompiler.CompilationFinished(Sender: TObject);
begin
if OutputFilter.Aborted then
FASyncrResult := mrAbort
else
FASyncResult := mrOK;
if TheProcess.Running then
begin
TheProcess.WaitOnExit;
if (FASyncResult = mrOk) and not (TheProcess.ExitStatus in [0,1]) then
begin
WriteError(Format(listCompilerInternalError, [TheProcess.ExitStatus]));
FASyncResult := mrCancel;
end;
end;
DebugLn('[TCompiler.Compile] Async end');
if Assigned(FFinishedCallback) then
FFinishedCallback(Self);
end;
{$ENDIF}
procedure TCompiler.WriteError(const Msg: string); procedure TCompiler.WriteError(const Msg: string);
begin begin
DebugLn('TCompiler.WriteError ',Msg); DebugLn('TCompiler.WriteError ',Msg);