IDE: if fpc path, fpc source directory or lazarus source directory not found: try secondary configs

git-svn-id: trunk@28083 -
This commit is contained in:
mattias 2010-11-05 01:16:37 +00:00
parent 0f54b04345
commit 7c80c43236
3 changed files with 41 additions and 4 deletions

View File

@ -1645,6 +1645,7 @@ procedure TEnvironmentOptions.SetFPCSourceDirectory(const AValue: string);
begin
if FFPCSourceDirectory=AValue then exit;
FFPCSourceDirectory:=AppendPathDelim(TrimFilename(AValue));
FFPCSrcDirParsedValid:=false;
end;
procedure TEnvironmentOptions.SetCompilerFilename(const AValue: string);

View File

@ -40,14 +40,15 @@ unit InitialSetupDlgs;
interface
uses
Classes, SysUtils, Forms, Controls, Buttons, Dialogs, FileUtil,
ComCtrls,
Classes, SysUtils, LCLProc, Forms, Controls, Buttons, Dialogs, FileUtil,
ComCtrls, Laz_XMLCfg,
LazarusIDEStrConsts, LazConf, EnvironmentOpts, IDEProcs;
procedure SetupCompilerFilename(var InteractiveSetup: boolean);
procedure SetupFPCSourceDirectory(var InteractiveSetup: boolean);
procedure SetupLazarusDirectory(var InteractiveSetup: boolean);
function GetValueFromSecondaryConfig(OptionFilename, Path: string): string;
implementation
@ -60,6 +61,9 @@ begin
CurCompilerFilename:=EnvironmentOptions.CompilerFilename;
if CurCompilerFilename='' then
CurCompilerFilename:=FindDefaultCompilerPath;
if not FileIsExecutable(CurCompilerFilename) then
CurCompilerFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/CompilerFilename/Value');
if not FileIsExecutable(CurCompilerFilename) then begin
if not InteractiveSetup then exit;
if CurCompilerFilename='' then begin
@ -101,6 +105,12 @@ begin
CurFPCSrcDir:=FindDefaultFPCSrcDirectory;
Changed:=true;
end;
if not DirectoryExistsUTF8(CurFPCSrcDir) then
begin
CurFPCSrcDir:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/FPCSourceDirectory/Value');
Changed:=true;
end;
if not CheckFPCSourceDir(CurFPCSrcDir) then begin
if (not InteractiveSetup)
or (not FileIsExecutable(EnvironmentOptions.CompilerFilename)) then
@ -145,6 +155,9 @@ begin
if not CheckLazarusDirectory(CurLazDir) then
CurLazDir:=FindDefaultLazarusSrcDirectory;
end;
if not CheckLazarusDirectory(CurLazDir) then
CurLazDir:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
'EnvironmentOptions/LazarusDirectory/Value');
if not CheckLazarusDirectory(CurLazDir) then begin
if not InteractiveSetup then exit;
if CurLazDir='' then begin
@ -172,5 +185,28 @@ begin
EnvironmentOptions.LazarusDirectory:=CurLazDir;
end;
function GetValueFromSecondaryConfig(OptionFilename, Path: string): string;
var
XMLConfig: TXMLConfig;
begin
if not FilenameIsAbsolute(OptionFilename) then
OptionFilename:=AppendPathDelim(GetSecondaryConfigPath)+OptionFilename;
if FileExistsCached(OptionFilename) then
begin
try
XMLConfig:=TXMLConfig.Create(OptionFilename);
try
Result:=XMLConfig.GetValue(Path,'');
finally
XMLConfig.Free;
end;
except
on E: Exception do begin
debugln(['GetValueFromSecondaryConfig File='+OptionFilename+': '+E.Message]);
end;
end;
end;
end;
end.

View File

@ -269,7 +269,7 @@ end;
procedure SetPrimaryConfigPath(const NewValue: String);
begin
debugln('SetPrimaryConfigPath NewValue="',UTF8ToConsole(NewValue),'" -> "',UTF8ToConsole(ExpandFileNameUTF8(NewValue)),'"');
PrimaryConfigPath := ExpandFileNameUTF8(NewValue);
PrimaryConfigPath := AppendPathDelim(ExpandFileNameUTF8(NewValue));
end;
{---------------------------------------------------------------------------
@ -278,7 +278,7 @@ end;
procedure SetSecondaryConfigPath(const NewValue: String);
begin
debugln('SetSecondaryConfigPath NewValue="',UTF8ToConsole(NewValue),'" -> "',UTF8ToConsole(ExpandFileNameUTF8(NewValue)),'"');
SecondaryConfigPath := ExpandFileNameUTF8(NewValue);
SecondaryConfigPath := AppendPathDelim(ExpandFileNameUTF8(NewValue));
end;
{---------------------------------------------------------------------------