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

IDE: added package option Write compiler config file

Browse Source
This commit is contained in:
mattias 2023-07-28 14:50:43 +01:00
parent 071135a4c9
commit 6ceeb57076
5 changed files with 70 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ide/lazbuild.lpr
View File

@ -787,6 +787,7 @@ var
function StartBuilding : boolean;
var
CfgCode: TCodeBuffer;
CfgFilename: String;
begin
Result := false;
@ -894,11 +895,12 @@ var
if Project1.CompilerOptions.WriteConfigFile then
begin
CfgCode:=Project1.WriteCompilerCfgFile(Project1,CompilerParams,CmdLineParams);
CfgFilename:=Project1.GetWriteConfigFilePath;
CfgCode:=WriteCompilerCfgFile(CfgFilename,CompilerParams,CmdLineParams);
if CfgCode=nil then
Error(ErrorBuildFailed,'unable to read "'+Project1.GetWriteConfigFilePath+'"');
Error(ErrorBuildFailed,'unable to read "'+CfgFilename+'"');
if CfgCode.FileOnDiskNeedsUpdate and (not CfgCode.Save) then
Error(ErrorBuildFailed,'unable to write "'+Project1.GetWriteConfigFilePath+'"');
Error(ErrorBuildFailed,'unable to write "'+CfgFilename+'"');
end;
// write state file to avoid building clean every time

7
ide/main.pp
View File

@ -6842,7 +6842,7 @@ var
TargetExeName: String;
TargetExeDirectory: String;
CompilerVersion: integer;
aCompileHint, ShortFilename: String;
aCompileHint, ShortFilename, CfgFilename: String;
OldToolStatus: TIDEToolStatus;
IsComplete: Boolean;
StartTime: TDateTime;
@ -7107,10 +7107,11 @@ begin
if Project1.CompilerOptions.WriteConfigFile then
begin
CfgCode:=Project1.WriteCompilerCfgFile(Project1,CompilerParams,CmdLineParams);
CfgFilename:=Project1.GetWriteConfigFilePath;
CfgCode:=WriteCompilerCfgFile(CfgFilename,CompilerParams,CmdLineParams);
if CfgCode=nil then begin
IDEMessageDialog(lisReadError,Format(lisUnableToReadFile2,
[Project1.GetWriteConfigFilePath]),mtError,[mbOk]);
[CfgFilename]),mtError,[mbOk]);
exit(mrCancel);
end;
if CfgCode.FileOnDiskNeedsUpdate and (SaveCodeBuffer(CfgCode)<>mrOk) then

36
ide/project.pp
View File

@ -1078,8 +1078,6 @@ type
function LoadStateFile(IgnoreErrors: boolean): TModalResult;
function SaveStateFile(const CompilerFilename: string; CompilerParams: TStrings;
Complete: boolean): TModalResult;
function WriteCompilerCfgFile(aProject: TProject; CompilerParams: TStrings;
out CmdLineParams: TStrings): TCodeBuffer;
// source editor
procedure UpdateAllCustomHighlighter;
@ -5321,40 +5319,6 @@ begin
Result:=mrOk;
end;
function TProject.WriteCompilerCfgFile(aProject: TProject;
CompilerParams: TStrings; out CmdLineParams: TStrings): TCodeBuffer;
var
CfgFile, Src, Param: String;
i: Integer;
begin
Result:=nil;
CmdLineParams:=TStringListUTF8Fast.Create;
CmdLineParams.Add('@'+aProject.GetWriteConfigFilePath);
CfgFile:=AProject.GetWriteConfigFilePath;
Src:='# Auto generated by Lazarus. Do not edit.'+LineEnding;
for i:=CompilerParams.Count-1 downto 0 do
begin
Param:=CompilerParams[i];
if (Param[1]='@')
or (Param='n')
or (Param[1]<>'-') then
CmdLineParams.Insert(1,Param)
else begin
Src+=Param+LineEnding;
CompilerParams.Delete(i);
end;
end;
Result:=CodeToolBoss.LoadFile(CfgFile,true,true);
if (Result=nil) and FileExistsCached(CfgFile) then
exit; // failed loading old cfg
if (Result<>nil) and (Result.Source=Src) then
exit; // nothing changed -> skip
if Result=nil then
Result:=CodeToolBoss.CreateFile(CfgFile);
Result.Source:=Src;
end;
procedure TProject.UpdateAllCustomHighlighter;
var
i: Integer;

6
packager/packagedefs.pas
View File

@ -634,6 +634,7 @@ type
function GetSrcFilename: string;
function GetSrcPPUFilename: string;
function GetCompilerFilename: string;
function GetWriteConfigFilePath: string;
function GetPOOutDirectory: string;
function GetUnitPath(RelativeToBaseDir: boolean): string;
function GetIncludePath(RelativeToBaseDir: boolean): string;
@ -3910,6 +3911,11 @@ begin
Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosCompilerPath);
end;
function TLazPackage.GetWriteConfigFilePath: string;
begin
Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosWriteConfigFilePath);
end;
function TLazPackage.GetPOOutDirectory: string;
begin
Result:=TrimFilename(SubstitutePkgMacros(fPOOutputDirectory,false));

57
packager/packagesystem.pas
View File

@ -538,6 +538,9 @@ function FPCParamNeedsBuildAll(const Param: String): boolean;
function FPCParamForBuildAllHasChanged(OldParams, NewParams: TStrings): boolean;
function RemoveFPCVerbosityParams(CompParams: TStrings): TStrings;
procedure WarnSuspiciousCompilerOptions(ViewCaption, Target: string; CompilerParams: TStrings);
function WriteCompilerCfgFile(CfgFilename: string; CompilerParams: TStrings;
out CmdLineParams: TStrings): TCodeBuffer;
implementation
@ -755,6 +758,39 @@ begin
end;
end;
function WriteCompilerCfgFile(CfgFilename: string; CompilerParams: TStrings;
out CmdLineParams: TStrings): TCodeBuffer;
var
Src, Param: String;
i: Integer;
begin
Result:=nil;
CmdLineParams:=TStringListUTF8Fast.Create;
CmdLineParams.Add('@'+CfgFilename);
Src:='# Auto generated by Lazarus. Do not edit.'+LineEnding;
for i:=CompilerParams.Count-1 downto 0 do
begin
Param:=CompilerParams[i];
if (Param[1]='@')
or (Param='n')
or (Param[1]<>'-') then
CmdLineParams.Insert(1,Param)
else begin
Src+=Param+LineEnding;
CompilerParams.Delete(i);
end;
end;
Result:=CodeToolBoss.LoadFile(CfgFilename,true,true);
if (Result=nil) and FileExistsCached(CfgFilename) then
exit; // failed loading old cfg
if (Result<>nil) and (Result.Source=Src) then
exit; // nothing changed -> skip
if Result=nil then
Result:=CodeToolBoss.CreateFile(CfgFilename);
Result.Source:=Src;
end;
{ TLazPackageGraphFileCache }
constructor TLazPackageGraphFileCache.Create(AOwner: TLazPackageGraph);
@ -4192,12 +4228,13 @@ var
CompilerFilename: String;
CompilePolicy: TPackageUpdatePolicy;
NeedBuildAllFlag, NeedBuildAll: Boolean;
CompilerParams: TStrings;
CompilerParams, CmdLineParams: TStrings;
Note: String;
WorkingDir: String;
ToolTitle: String;
ToolTitle, CfgFilename: String;
ExtToolData: TLazPkgGraphExtToolData;
BuildMethod: TBuildMethod;
CfgCode: TCodeBuffer;
begin
Result:=mrCancel;
@ -4252,6 +4289,7 @@ begin
end;
CompilerParams:=nil;
CmdLineParams:=nil;
try
if (BuildItem=nil) and (LazarusIDE<>nil) then
LazarusIDE.MainBarSubTitle:=APackage.Name;
@ -4346,6 +4384,19 @@ begin
NeedBuildAll:=true;
WarnSuspiciousCompilerOptions('Compile checks','package '+APackage.IDAsString+':',CompilerParams);
if APackage.CompilerOptions.WriteConfigFile then
begin
CfgFilename:=APackage.GetWriteConfigFilePath;
CfgCode:=WriteCompilerCfgFile(CfgFilename,CompilerParams,CmdLineParams);
if CfgCode=nil then begin
IDEMessageDialog(lisReadError,Format(lisUnableToReadFile2,
[CfgFilename]),mtError,[mbOk]);
exit(mrCancel);
end;
if CfgCode.FileOnDiskNeedsUpdate and (SaveCodeBuffer(CfgCode)<>mrOk) then
exit(mrCancel);
end;
end else begin
CompilerFilename:='fppkg';
CompilerParams:=TStringListUTF8Fast.Create;
@ -4451,6 +4502,8 @@ begin
end;
Result:=mrOk;
finally
if CmdLineParams<>CompilerParams then
CmdLineParams.Free;
CompilerParams.Free;
if (BuildItem=nil) and (LazarusIDE<>nil) then
LazarusIDE.MainBarSubTitle:='';