lplupdate: read lazarus.cfg to ignore pcp

This commit is contained in:
mattias 2023-09-12 14:39:35 +02:00
parent 9e29d23b1f
commit 748351eb53

View File

@ -95,6 +95,7 @@ type
FExecuteCommands: boolean; FExecuteCommands: boolean;
FLazarusDir: string; FLazarusDir: string;
FLinksDir: string; FLinksDir: string;
FPCP: string;
FPkgDir: string; FPkgDir: string;
FQuiet: Boolean; FQuiet: Boolean;
FVerbose: Boolean; FVerbose: Boolean;
@ -119,6 +120,7 @@ type
function GetDefaultPkgDirectory: string; function GetDefaultPkgDirectory: string;
function GetDefaultLinksDirectory: string; function GetDefaultLinksDirectory: string;
property LazarusDir: string read FLazarusDir write FLazarusDir; property LazarusDir: string read FLazarusDir write FLazarusDir;
property PCP: string read FPCP write FPCP; // primary-config-path, with trailing PathDelim
property PkgDir: string read FPkgDir write FPkgDir; property PkgDir: string read FPkgDir write FPkgDir;
property LinksDir: string read FLinksDir write FLinksDir; property LinksDir: string read FLinksDir write FLinksDir;
property Verbose: Boolean read FVerbose write FVerbose; property Verbose: Boolean read FVerbose write FVerbose;
@ -217,6 +219,8 @@ procedure TLPLUpdate.ScanPackages(Dir: string; Packages: TPackages);
var var
FileInfo: TSearchRec; FileInfo: TSearchRec;
begin begin
if (PCP<>'') and (CompareFilenames(PCP,Dir)=0) then exit;
if FindFirstUTF8(Dir+FileMask,faAnyFile,FileInfo)=0 then if FindFirstUTF8(Dir+FileMask,faAnyFile,FileInfo)=0 then
begin begin
repeat repeat
@ -529,16 +533,47 @@ begin
end; end;
function TLPLUpdate.GetDefaultLazarusDir: string; function TLPLUpdate.GetDefaultLazarusDir: string;
var
LazCfgFilename, Line, BaseDir, ParamName, ParamValue: String;
sl: TStringList;
i: Integer;
p: SizeInt;
begin begin
if GetEnvironmentVariableUTF8('LAZARUSDIR')<>'' then if GetEnvironmentVariableUTF8('LAZARUSDIR')<>'' then
Result:=GetEnvironmentVariableUTF8('LAZARUSDIR') Result:=GetEnvironmentVariableUTF8('LAZARUSDIR')
else begin else begin
Result:=ChompPathDelim(GetCurrentDirUTF8); Result:=ChompPathDelim(GetCurrentDirUTF8);
if (ExtractFileName(Result)='tools') if (ExtractFileName(Result)='tools')
and (DirPathExists(ExtractFilePath(Result)+'packager')) then begin and (DirPathExists(ExtractFilePath(Result)+'packager')) then
begin
// common mistake: lplupdate started in tools // common mistake: lplupdate started in tools
Result:=ExtractFilePath(Result) Result:=ExtractFilePath(Result)
end; end;
BaseDir:=AppendPathDelim(Result);
LazCfgFilename:=BaseDir+'lazarus.cfg';
if FileExists(LazCfgFilename) then
begin
// read lazarus.cfg
sl:=TStringList.Create;
try
sl.LoadFromFile(LazCfgFilename);
for i:=0 to sl.Count-1 do begin
Line:=sl[i];
p:=Pos('=',Line);
if p<1 then continue;
ParamName:=lowercase(LeftStr(Line,p-1));
ParamValue:=copy(Line,p+1,length(Line));
case ParamName of
'--pcp',
'--primary-config-path':
PCP:=AppendPathDelim(ExpandFileNameUTF8(ParamValue,BaseDir));
end;
end;
finally
sl.Free;
end;
end;
end; end;
Result:=CleanAndExpandDirectory(Result); Result:=CleanAndExpandDirectory(Result);
end; end;