{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: Procedures and dialogs to check environment. The IDE uses these procedures at startup to check for example the lazarus directory and warns if it looks suspicious and choose another. } unit InitialSetupProc; {$mode objfpc}{$H+} interface uses // RTL + FCL Classes, SysUtils, StrUtils, Contnrs, // CodeTools DefineTemplates, CodeToolManager, FileProcs, // LazUtils FPCAdds, LazFileCache, LazUTF8, LazFileUtils, FileUtil, LazLoggerBase, Laz2_XMLCfg, // IDEIntf IdeIntfStrConsts, // IDE LazarusIDEStrConsts, LazConf, EnvironmentOpts, FppkgHelper; type TSDFilenameQuality = ( sddqInvalid, sddqWrongMinorVersion, sddqWrongVersion, sddqIncomplete, sddqCompatible, sddqMakeNotWithFpc, // Make not in the same directory as compiler sddqHint ); TSDFileQuality = ( sdfOk, sdfNotFound, sdfIsDirectory, sdfNotExecutable ); TSDFileInfo = class public Filename: string; // macros resolved, trimmed, expanded Caption: string; // filename with macros Note: string; Quality: TSDFilenameQuality; end; TSDFileInfoList = class (TObjectList) public function AddNewItem(aFilename, aCaption: string): TSDFileInfo; function CaptionExists(aCaption: string): boolean; function BestDir: TSDFileInfo; end; TSDFilenameType = ( sddtLazarusSrcDir, sddtCompilerFilename, sddtFPCSrcDir, sddtMakeExeFilename, sddtDebuggerFilename, sddtFppkgFpcPrefix ); TSDFlag = ( sdfCompilerFilenameNeedsUpdate, sdfFPCSrcDirNeedsUpdate, sdfMakeExeFilenameNeedsUpdate, sdfDebuggerFilenameNeedsUpdate, sdfFppkgConfigFileNeedsUpdate ); TSDFlags = set of TSDFlag; // Lazarus Directory function CheckLazarusDirectoryQuality(ADirectory: string; out Note: string): TSDFilenameQuality; function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TSDFileInfoList; procedure SetupLazarusDirectory; // FreePascal Compiler function CheckFPCExeQuality(AFilename: string; out Note: string; TestSrcFilename: string): TSDFilenameQuality; function SearchFPCExeCandidates(StopIfFits: boolean; const TestSrcFilename: string): TSDFileInfoList; procedure SetupFPCExeFilename; function FindDefaultCompilerPath: string; // full path of GetDefaultCompilerFilename procedure GetDefaultCompilerFilenames(List: TStrings); // list of standard paths of compiler on various distributions // Pas2js compiler function CheckPas2jsQuality(AFilename: string; out Note: string; TestSrcFilename: string): TSDFilenameQuality; // FPC Source function CheckFPCSrcDirQuality(ADirectory: string; out Note: string; const FPCVer: String; aUseFileCache: Boolean = True): TSDFilenameQuality; function SearchFPCSrcDirCandidates(StopIfFits: boolean; const FPCVer: string): TSDFileInfoList; // Debugger // Checks a given file to see if it is a valid debugger (only gdb supported for now) function CheckDebuggerQuality(AFilename: string): TSDFileQuality; // Fppkg function CheckFppkgConfiguration(var ConfigFile: string; out Msg: string): TSDFilenameQuality; function CheckFppkgConfigFile(const AFilename: string; out Note: string): TSDFilenameQuality; // Make // Checks a given file to see if it is a valid make executable function CheckMakeExeQuality(AFilename: string; out Note: string): TSDFilenameQuality; // Search make candidates and add them to the list, including quality level function SearchMakeExeCandidates(StopIfFits: boolean): TSDFileInfoList; function GetValueFromPrimaryConfig(OptionFilename, Path: string): string; function GetValueFromSecondaryConfig(OptionFilename, Path: string): string; function GetValueFromIDEConfig(OptionFilename, Path: string): string; implementation {$IFDEF MSWindows} var DefaultFPCVersion: string; DefaultFPCTarget: string; DefaultDrive: string; {$ENDIF} function CheckLazarusDirectoryQuality(ADirectory: string; out Note: string): TSDFilenameQuality; function SubDirExists(SubDir: string; var q: TSDFilenameQuality): boolean; begin SubDir:=GetForcedPathDelims(SubDir); if DirPathExistsCached(ADirectory+SubDir) then exit(true); Result:=false; Note:=Format(lisDirectoryNotFound2, [SubDir]); q:=sddqIncomplete; end; function SubFileExists(SubFile: string; var q: TSDFilenameQuality): boolean; begin SubFile:=GetForcedPathDelims(SubFile); if FileExistsCached(ADirectory+SubFile) then exit(true); Result:=false; Note:=Format(lisFileNotFound3, [SubFile]); q:=sddqIncomplete; end; var sl: TStringList; VersionIncFile: String; Version: String; begin Result:=sddqInvalid; ADirectory:=TrimFilename(ADirectory); if not DirPathExistsCached(ADirectory) then begin Note:=lisISDDirectoryNotFound; exit; end; ADirectory:=AppendPathDelim(ADirectory); if not SubDirExists('lcl',Result) then exit; if not SubDirExists('packager/globallinks',Result) then exit; if not SubDirExists('ide',Result) then exit; if not SubDirExists('components',Result) then exit; if not SubFileExists('ide/lazarus.lpi',Result) then exit; VersionIncFile:=GetForcedPathDelims('ide/packages/ideconfig/version.inc'); if not SubFileExists(VersionIncFile,Result) then exit; sl:=TStringList.Create; try try sl.LoadFromFile(ADirectory+VersionIncFile); if (sl.Count=0) or (sl[0]='') or (sl[0][1]<>'''') then begin Note:=Format(lisInvalidVersionIn, [VersionIncFile]); exit; end; Version:=copy(sl[0],2,length(sl[0])-2); if Version<>LazarusVersionStr then begin Note:=Format(lisWrongVersionIn, [VersionIncFile, Version]); Result:=sddqWrongVersion; exit; end; Note:=lisOk; Result:=sddqCompatible; except on E: Exception do begin Note:=Format(lisUnableToLoadFile2, [VersionIncFile, E.Message]); exit; end; end; finally sl.Free; end; end; function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TSDFileInfoList; function CheckDir(Dir: string; var List: TSDFileInfoList): boolean; var Item: TSDFileInfo; RealDir: String; begin Result:=false; if Dir='' then Dir:='.'; ForcePathDelims(Dir); Dir:=ChompPathDelim(Dir); // check if already checked if Assigned(List) and List.CaptionExists(Dir) then exit; EnvironmentOptions.LazarusDirectory:=Dir; RealDir:=ChompPathDelim(EnvironmentOptions.GetParsedLazarusDirectory); DebugLn(['SearchLazarusDirectoryCandidates Value=',Dir,' File=',RealDir]); // check if exists if not DirPathExistsCached(RealDir) then exit; // add to list and check quality if List=nil then List:=TSDFileInfoList.create(true); Item:=List.AddNewItem(RealDir, Dir); Item.Quality:=CheckLazarusDirectoryQuality(RealDir, Item.Note); Result:=(Item.Quality=sddqCompatible) and StopIfFits; end; function CheckViaExe(Filename: string; var List: TSDFileInfoList): boolean; begin Result:=false; Filename:=FindDefaultExecutablePath(Filename); if Filename='' then exit; Filename:=GetPhysicalFilenameCached(Filename,true); if Filename='' then exit; Result:=CheckDir(ExtractFilePath(Filename),List); end; var Dir: String; ResolvedDir: String; Dirs: TStringList; i: Integer; OldLazarusDir: String; begin Result:=nil; OldLazarusDir:=EnvironmentOptions.LazarusDirectory; try // first check the value in the options if CheckDir(EnvironmentOptions.LazarusDirectory,Result) then exit; // then check the directory of the executable Dir:=ProgramDirectoryWithBundle; if CheckDir(Dir,Result) then exit; ResolvedDir:=GetPhysicalFilenameCached(Dir,false); if (ResolvedDir<>Dir) and (CheckDir(ResolvedDir,Result)) then exit; // check the primary options Dir:=GetValueFromPrimaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/LazarusDirectory/Value'); if CheckDir(Dir,Result) then exit; // check the secondary options Dir:=GetValueFromSecondaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/LazarusDirectory/Value'); if CheckDir(Dir,Result) then exit; // check common directories Dirs:=GetDefaultLazarusSrcDirectories; try for i:=0 to Dirs.Count-1 do if CheckDir(Dirs[i],Result) then exit; finally Dirs.Free; end; // check history Dirs:=EnvironmentOptions.LazarusDirHistory; if Dirs<>nil then for i:=0 to Dirs.Count-1 do if CheckDir(Dirs[i],Result) then exit; // search lazarus-ide and lazarus in PATH, then follow the links, // which will lead to the lazarus directory if CheckViaExe('lazarus-ide'+GetExecutableExt,Result) then exit; if CheckViaExe('lazarus'+GetExecutableExt,Result) then exit; finally EnvironmentOptions.LazarusDirectory:=OldLazarusDir; end; end; procedure SetupLazarusDirectory; var Dir, Note: String; Quality: TSDFilenameQuality; List: TSDFileInfoList; begin Dir:=EnvironmentOptions.GetParsedLazarusDirectory; Quality:=CheckLazarusDirectoryQuality(Dir,Note); if Quality<>sddqInvalid then exit; // bad lazarus directory => searching a good one dbgout('SetupLazarusDirectory:'); if EnvironmentOptions.LazarusDirectory<>'' then begin dbgout(' The Lazarus directory "',EnvironmentOptions.LazarusDirectory,'"'); if EnvironmentOptions.LazarusDirectory<>Dir then dbgout(' => "',Dir,'"'); dbgout(' is invalid (Error: ',Note,')'); debugln(' Searching a proper one ...'); end else begin debugln(' Searching ...'); end; List:=SearchLazarusDirectoryCandidates(true); try if (List=nil) or (List.BestDir.Quality=sddqInvalid) then begin debugln(['SetupLazarusDirectory: no proper Lazarus directory found.']); exit; end; EnvironmentOptions.LazarusDirectory:=List.BestDir.Filename; debugln(['SetupLazarusDirectory: using ',EnvironmentOptions.LazarusDirectory]); finally List.Free; end; end; function CheckFPCExeQuality(AFilename: string; out Note: string; TestSrcFilename: string): TSDFilenameQuality; var CfgCache: TPCTargetConfigCache; function CheckPPU(const AnUnitName: string): boolean; begin if (CfgCache.Units=nil) or not FilenameExtIs(CfgCache.Units[AnUnitName],'ppu',true) then begin Note:=Format(lisPpuNotFoundCheckYourFpcCfg, [AnUnitName]); Result:=false; end else Result:=true; end; var i: LongInt; ShortFilename: String; begin Result:=sddqInvalid; AFilename:=TrimFilename(AFilename); if not FileExistsCached(AFilename) then begin Note:=lisFileNotFound4; exit; end; if DirPathExistsCached(AFilename) then begin Note:=lisFileIsDirectory; exit; end; if not FileIsExecutableCached(AFilename) then begin Note:=lisFileIsNotAnExecutable; exit; end; // do not execute unusual exe files ShortFilename:=ExtractFileNameOnly(AFilename); if (CompareFilenames(ShortFilename,'fpc')<>0) and (CompareFilenames(LeftStr(ShortFilename,3),'ppc')<>0) then begin Note:=lisUnusualCompilerFileNameUsuallyItStartsWithFpcPpcOr; exit(sddqIncomplete); end; if TestSrcFilename<>'' then begin CfgCache:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find( AFilename,'','','',true); if CfgCache.NeedsUpdate then CfgCache.Update(TestSrcFilename); i:=CfgCache.IndexOfUsedCfgFile; if i<0 then begin Note:=CTSafeFormat(lisCompilerCfgIsMissing,['fpc.cfg']); exit; end; if not CfgCache.HasPPUs then begin Note:=lisSystemPpuNotFoundCheckYourFpcCfg; exit; end; if (CfgCache.RealTargetCPU='jvm') then begin if not CheckPPU('uuchar') then exit; end else begin if not CheckPPU('classes') then exit; end; end; Note:=lisOk; Result:=sddqCompatible; end; function SearchFPCExeCandidates(StopIfFits: boolean; const TestSrcFilename: string): TSDFileInfoList; var ShortCompFile: String; function CheckFile(AFilename: string; var List: TSDFileInfoList): boolean; var Item: TSDFileInfo; RealFilename: String; begin Result:=false; if AFilename='' then exit; ForcePathDelims(AFilename); // check if already checked if Assigned(List) and List.CaptionExists(AFilename) then exit; EnvironmentOptions.CompilerFilename:=AFilename; RealFilename:=EnvironmentOptions.GetParsedCompilerFilename; debugln(['SearchCompilerCandidates Value=',AFilename,' File=',RealFilename]); if RealFilename='' then exit; // check if exists if not FileExistsCached(RealFilename) then exit; // add to list and check quality if List=nil then List:=TSDFileInfoList.create(true); Item:=List.AddNewItem(RealFilename, AFilename); Item.Quality:=CheckFPCExeQuality(RealFilename, Item.Note, TestSrcFilename); Result:=(Item.Quality=sddqCompatible) and StopIfFits; end; function CheckSubDirs(ADir: string; var List: TSDFileInfoList): boolean; // search for ADir\bin\i386-win32\fpc.exe // and for ADir\*\bin\i386-win32\fpc.exe var FileInfo: TSearchRec; SubFile: String; begin Result:=true; ADir:=AppendPathDelim(TrimFilename(ExpandFileNameUTF8(TrimFilename(ADir)))); SubFile:='bin/$(TargetCPU)-$(TargetOS)/'+ShortCompFile; if CheckFile(ADir+SubFile,List) then exit; try if FindFirstUTF8(ADir+AllFilesMask,faAnyFile,FileInfo)=0 then begin repeat // check if special file if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then continue; if ((FileInfo.Attr and faDirectory)>0) and CheckFile(ADir+FileInfo.Name+PathDelim+SubFile,List) then exit; until FindNextUTF8(FileInfo)<>0; end; finally FindCloseUTF8(FileInfo); end; Result:=false; end; var AFilename: String; Files: TStringList; i: Integer; SysDrive: String; ProgDir: String; OldCompilerFilename: String; begin Result:=nil; OldCompilerFilename:=EnvironmentOptions.CompilerFilename; try // check current setting if CheckFile(EnvironmentOptions.CompilerFilename,Result) then exit; // check the primary options AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/CompilerFilename/Value'); if CheckFile(AFilename,Result) then exit; // check the secondary options AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/CompilerFilename/Value'); if CheckFile(AFilename,Result) then exit; // check environment variable PP AFileName := GetEnvironmentVariableUTF8('PP'); if CheckFile(AFilename,Result) then exit; // search fpc(.exe) in PATH if CheckFile('fpc'+ExeExt,Result) then exit; // search ppccpu(.exe) in PATH if CheckFile(GetDefaultCompilerFilename(GetCompiledTargetCPU),Result) then exit; // check history Files:=EnvironmentOptions.CompilerFileHistory; if Files<>nil then for i:=0 to Files.Count-1 do if CheckFile(Files[i],Result) then exit; // check paths with versions ShortCompFile:='fpc'+ExeExt; // check $(LazarusDir)\fpc\3.0.0\bin\i386-win32\fpc.exe if CheckFile(GetForcedPathDelims('$(LazarusDir)/fpc/'+{$I %FPCVERSION%}+'/bin/'+GetCompiledTargetCPU+'-'+GetCompiledTargetOS+'/')+ShortCompFile,Result) then exit; // check $(LazarusDir)\fpc\bin\i386-win32\fpc.exe if CheckFile(GetForcedPathDelims('$(LazarusDir)/fpc/bin/'+GetCompiledTargetCPU+'-'+GetCompiledTargetOS+'/')+ShortCompFile,Result) then exit; // check common directories Files:=TStringList.Create; try GetDefaultCompilerFilenames(Files); for i:=0 to Files.Count-1 do if CheckFile(Files[i],Result) then exit; finally Files.Free; end; // Windows-only locations: if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin SysDrive:=GetEnvironmentVariableUTF8('SYSTEMDRIVE'); if SysDrive='' then SysDrive:='C:'; SysDrive:=AppendPathDelim(SysDrive); // %SYSTEMDRIVE%\fpc\ if CheckSubDirs(SysDrive+'FPC',Result) then exit; // %SYSTEMDRIVE%\pp\ if CheckSubDirs(SysDrive+'pp',Result) then exit; // %PROGRAMFILES%\FPC\* ProgDir:=AppendPathDelim(GetEnvironmentVariableUTF8('PROGRAMFILES')); if (ProgDir<>'') and CheckSubDirs(ProgDir+'FPC',Result) then exit; end; finally EnvironmentOptions.CompilerFilename:=OldCompilerFilename; end; end; procedure SetupFPCExeFilename; var Filename, Note: String; Quality: TSDFilenameQuality; List: TSDFileInfoList; begin Filename:=EnvironmentOptions.GetParsedCompilerFilename; Quality:=CheckFPCExeQuality(Filename,Note,''); if Quality<>sddqInvalid then exit; // bad compiler dbgout('SetupCompilerFilename:'); if EnvironmentOptions.CompilerFilename<>'' then begin dbgout(' The compiler path "',EnvironmentOptions.CompilerFilename,'"'); if EnvironmentOptions.CompilerFilename<>Filename then dbgout(' => "',Filename,'"'); dbgout(' is invalid (Error: ',Note,')'); debugln(' Searching a proper one ...'); end else begin debugln(' Searching compiler ...'); end; List:=SearchFPCExeCandidates(true, CodeToolBoss.CompilerDefinesCache.TestFilename); try if (List=nil) or (List.BestDir.Quality=sddqInvalid) then begin debugln(['SetupCompilerFilename: no proper compiler found.']); exit; end; EnvironmentOptions.CompilerFilename:=List.BestDir.Filename; debugln(['SetupCompilerFilename: using ',EnvironmentOptions.CompilerFilename]); finally List.Free; end; end; function FindDefaultCompilerPath: string; var FileNames: TStringList; i: Integer; begin {$IFDEF MSWindows} Result := SearchFileInPath(GetDefaultCompilerFilename, format('%sfpc\%s\bin\%s', [AppendPathDelim(ProgramDirectory), DefaultFPCVersion, DefaultFPCTarget]), GetEnvironmentVariableUTF8('PATH'),';', []); if Result <> '' then exit; Result := DefaultDrive + AppendPathDelim(ProgramDirectory) + format('fpc\%s\bin\%s\%s', [DefaultFPCVersion, DefaultFPCTarget, GetDefaultCompilerFilename]); {$ELSE} Result:=FindDefaultExecutablePath(GetDefaultCompilerFilename); {$ENDIF} if FileExistsUTF8(Result) then exit; FileNames := TStringList.Create; GetDefaultCompilerFilenames(FileNames); try for i := 0 to FileNames.Count -1 do begin Result := FileNames[i]; if FileExistsUTF8(Result) then exit; end; finally FileNames.Free; end; Result := ''; end; procedure GetDefaultCompilerFilenames(List: TStrings); begin {$IFDEF MSWindows} List.Add(DefaultDrive + format('\fpc\%s\bin\%s\%s', [DefaultFPCVersion, DefaultFPCTarget, GetDefaultCompilerFilename])); List.Add(AppendPathDelim(ProgramDirectory) + format('fpc\%s\bin\%s\%s', [DefaultFPCVersion, DefaultFPCTarget, GetDefaultCompilerFilename])); {$ELSE} AddFilenameToList(List,'/usr/local/bin/'+GetDefaultCompilerFilename); AddFilenameToList(List,'/usr/bin/'+GetDefaultCompilerFilename); AddFilenameToList(List,'/opt/fpc/'+GetDefaultCompilerFilename); {$ENDIF} end; function ValueOfKey(const aLine, aKey: string; var aValue: string): boolean; // If aKey is found in aLine, separate a quoted number following "aKey =", // save it to aValue and return True. Return False if aKey is not found. // Example line: version_nr = '2'; var i,j: Integer; begin Result:=False; i:=Pos(aKey, aLine); if i>0 then begin // aKey found i:=PosEx('=', aLine, i+Length(aKey)); if i>0 then begin // '=' found i:=PosEx('''', aLine, i+1); if i>0 then begin // Opening quote found j:=PosEx('''', aLine, i+1); if j>0 then begin // Closing quote found aValue:=Copy(aLine, i+1, j-i-1); Result:=True; end; end; end; end; end; function CheckPas2jsQuality(AFilename: string; out Note: string; TestSrcFilename: string): TSDFilenameQuality; var i: LongInt; ShortFilename: String; CfgCache: TPCTargetConfigCache; begin Result:=sddqInvalid; AFilename:=TrimFilename(AFilename); if not FileExistsCached(AFilename) then begin Note:=lisFileNotFound4; exit; end; if DirPathExistsCached(AFilename) then begin Note:=lisFileIsDirectory; exit; end; if not FileIsExecutableCached(AFilename) then begin Note:=lisFileIsNotAnExecutable; exit; end; // do not execute unusual exe files ShortFilename:=ExtractFileNameOnly(AFilename); if (CompareText(LeftStr(ShortFilename,6),'pas2js')<>0) then begin Note:=lisUnusualPas2jsCompilerFileNameUsuallyItStartsWithPa; exit(sddqIncomplete); end; if TestSrcFilename<>'' then begin CfgCache:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find( AFilename,'','','',true); if CfgCache.NeedsUpdate then CfgCache.Update(TestSrcFilename); i:=CfgCache.IndexOfUsedCfgFile; if i<0 then begin Note:=CTSafeFormat(lisCompilerCfgIsMissing,['pas2js.cfg']); exit; end; //if not CheckPas('classes') then exit; end; Note:=lisOk; Result:=sddqCompatible; end; function CheckFPCSrcDirQuality(ADirectory: string; out Note: string; const FPCVer: String; aUseFileCache: Boolean = True): TSDFilenameQuality; // aUseFileCache = False when this function is called from a thread. // File Cache is not thread safe. function DirPathExistsInternal(const FileName: String): Boolean; begin if aUseFileCache then Result:=DirPathExistsCached(FileName) else Result:=DirPathExists(FileName) end; function FileExistsInternal(const Filename: string): boolean; begin if aUseFileCache then Result:=FileExistsCached(FileName) else Result:=FileExistsUTF8(FileName) end; function SubDirExists(SubDir: string): boolean; begin SubDir:=GetForcedPathDelims(SubDir); if DirPathExistsInternal(ADirectory+SubDir) then exit(true); Result:=false; Note:=Format(lisDirectoryNotFound2, [SubDir]); end; function SubFileExists(SubFile: string): boolean; begin SubFile:=GetForcedPathDelims(SubFile); if FileExistsInternal(ADirectory+SubFile) then exit(true); Result:=false; Note:=Format(lisFileNotFound3, [SubFile]); end; var VersionFile: String; sl: TStringList; i: Integer; VersionNr: String; ReleaseNr: String; PatchNr: String; SrcVer: String; Line: String; begin Result:=sddqInvalid; Note:=''; ADirectory:=TrimFilename(ADirectory); if not DirPathExistsInternal(ADirectory) then begin Note:=lisISDDirectoryNotFound; exit; end; ADirectory:=AppendPathDelim(ADirectory); if not SubDirExists('rtl') then exit; if not SubDirExists('packages') then exit; Result:=sddqIncomplete; if not SubFileExists('rtl/linux/system.pp') then exit; // check version if (FPCVer<>'') then begin VersionFile:=ADirectory+'compiler'+PathDelim+'version.pas'; if FileExistsInternal(VersionFile) then begin sl:=TStringList.Create; try try sl.LoadFromFile(VersionFile); VersionNr:=''; ReleaseNr:=''; PatchNr:=''; for i:=0 to sl.Count-1 do begin Line:=sl[i]; if ValueOfKey(Line,'version_nr', VersionNr) then begin end else if ValueOfKey(Line,'release_nr', ReleaseNr) then begin end else if ValueOfKey(Line,'patch_nr', PatchNr) then break; end; SrcVer:=VersionNr+'.'+ReleaseNr+'.'+PatchNr; if SrcVer<>FPCVer then begin Note:=Format(lisFoundVersionExpected, [SrcVer, FPCVer]); SrcVer:=VersionNr+'.'+ReleaseNr+'.'; if LeftStr(FPCVer,length(SrcVer))=SrcVer then Result:=sddqWrongMinorVersion else Result:=sddqWrongVersion; exit; end; except end; finally sl.Free; end; end; end; Note:=lisOk; Result:=sddqCompatible; end; function SearchFPCSrcDirCandidates(StopIfFits: boolean; const FPCVer: string): TSDFileInfoList; function Check(Dir: string; var List: TSDFileInfoList): boolean; var Item: TSDFileInfo; RealDir: String; begin Result:=false; Dir:=ChompPathDelim(GetForcedPathDelims(Dir)); if Dir='' then exit; // check if already checked if Assigned(List) and List.CaptionExists(Dir) then exit; EnvironmentOptions.FPCSourceDirectory:=Dir; RealDir:=EnvironmentOptions.GetParsedFPCSourceDirectory; debugln(['SearchFPCSrcDirCandidates Value=',Dir,' File=',RealDir]); if RealDir='' then exit; // check if exists if not DirPathExistsCached(RealDir) then exit; // add to list and check quality if List=nil then List:=TSDFileInfoList.Create(true); Item:=List.AddNewItem(RealDir, Dir); Item.Quality:=CheckFPCSrcDirQuality(RealDir, Item.Note, FPCVer); Result:=(Item.Quality=sddqCompatible) and StopIfFits; end; var AFilename: String; Dirs: TStringList; i: Integer; OldFPCSrcDir: String; begin Result:=nil; OldFPCSrcDir:=EnvironmentOptions.FPCSourceDirectory; try // check current setting if Check(EnvironmentOptions.FPCSourceDirectory,Result) then exit; // check the primary options AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/FPCSourceDirectory/Value'); if Check(AFilename,Result) then exit; // check the secondary options AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/FPCSourceDirectory/Value'); if Check(AFilename,Result) then exit; // check environment variable FPCDIR AFileName := GetEnvironmentVariableUTF8('FPCDIR'); if Check(AFilename,Result) then exit; // check relative to FPCDIR if AFileName <> '' then if Check(AFilename + '/../fpcsrc', Result) then exit; // check history Dirs:=EnvironmentOptions.FPCSourceDirHistory; if Dirs<>nil then for i:=0 to Dirs.Count-1 do if Check(Dirs[i],Result) then exit; // $(LazarusDir)/fpc/$(FPCVer)/source AFilename:='$(LazarusDir)/fpc/$(FPCVer)/source'; if Check(AFilename,Result) then exit; // check relative to fpc.exe AFilename:='$Path($(CompPath))/../../source'; if Check(AFilename,Result) then exit; // check common directories Dirs:=GetDefaultFPCSrcDirectories; try if Dirs<>nil then for i:=0 to Dirs.Count-1 do if Check(Dirs[i],Result) then exit; finally Dirs.Free; end; finally EnvironmentOptions.FPCSourceDirectory:=OldFPCSrcDir; end; end; function CheckDebuggerQuality(AFilename: string): TSDFileQuality; begin AFilename:=TrimFilename(AFilename); AFilename := EnvironmentOptions.GetParsedValue(eopDebuggerFilename, AFilename); if not FileExistsCached(AFilename) then begin Result:=sdfNotFound; exit; end; if DirPathExistsCached(AFilename) then begin Result:=sdfIsDirectory; exit; end; if not FileIsExecutableCached(AFilename) then begin Result:=sdfNotExecutable; exit; end; Result:=sdfOk; end; function CheckFppkgConfiguration(var ConfigFile: string; out Msg: string): TSDFilenameQuality; var Fppkg: TFppkgHelper; begin Fppkg := TFppkgHelper.Instance; Fppkg.OverrideConfigurationFilename := ConfigFile; if Fppkg.IsProperlyConfigured(Msg) then Result := sddqCompatible else Result := sddqInvalid; ConfigFile := Fppkg.GetConfigurationFileName; end; function CheckFppkgConfigFile(const AFilename: string; out Note: string): TSDFilenameQuality; begin Note := ''; if AFilename='' then begin Result := sddqCompatible; end else begin if not FileExistsCached(AFilename) then begin Result := sddqIncomplete; Note:=lisFileNotFound; end else begin if DirectoryExists(AFilename) then begin Result := sddqInvalid; Note:=lisFileIsDirectory; end else Result := sddqCompatible; end; end; end; function CheckMakeExeQuality(AFilename: string; out Note: string ): TSDFilenameQuality; begin Result:=sddqInvalid; AFilename:=TrimFilename(AFilename); if not FileExistsCached(AFilename) then begin Note:=lisFileNotFound4; exit; end; if DirPathExistsCached(AFilename) then begin Note:=lisFileIsDirectory; exit; end; if not FileIsExecutableCached(AFilename) then begin Note:=lisFileIsNotAnExecutable; exit; end; // Windows-only locations: if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin // under Windows, make.exe is in the same directory as fpc.exe // other make.exe are often incompatible if not FileExistsCached(ExtractFilePath(AFilename)+'fpc.exe') then begin Note:=Format(lisThereIsNoFpcExeInTheDirectoryOfUsuallyTheMakeExecu, [ ExtractFilename(AFilename)]); Result:=sddqMakeNotWithFpc; exit; end; end; Note:=lisOk; Result:=sddqCompatible; end; function SearchMakeExeCandidates(StopIfFits: boolean): TSDFileInfoList; function CheckFile(AFilename: string; var List: TSDFileInfoList): boolean; var Item: TSDFileInfo; RealFilename: String; begin Result:=false; if AFilename='' then exit; ForcePathDelims(AFilename); // check if already checked if Assigned(List) and List.CaptionExists(AFilename) then exit; EnvironmentOptions.MakeFilename:=AFilename; RealFilename:=EnvironmentOptions.GetParsedMakeFilename; debugln(['SearchMakeExeCandidates Value=',AFilename,' File=',RealFilename]); if RealFilename='' then exit; // check if exists if not FileExistsCached(RealFilename) then exit; // add to list and check quality if List=nil then List:=TSDFileInfoList.create(true); Item:=List.AddNewItem(RealFilename, AFilename); Item.Quality:=CheckMakeExeQuality(RealFilename, Item.Note); Result:=(Item.Quality=sddqCompatible) or ((Item.Quality=sddqMakeNotWithFpc) and StopIfFits); end; var OldMakeFilename: String; AFilename: String; Files: TStringList; i: Integer; begin Result:=nil; OldMakeFilename:=EnvironmentOptions.MakeFilename; try // check current setting if CheckFile(EnvironmentOptions.MakeFilename,Result) then exit; // check the primary options AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/MakeFilename/Value'); if CheckFile(AFilename,Result) then exit; // check the secondary options AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName, 'EnvironmentOptions/MakeFilename/Value'); if CheckFile(AFilename,Result) then exit; // Windows-only locations: if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin // check make in fpc.exe directory if CheckFile(GetForcedPathDelims('$Path($(CompPath))\make.exe'),Result) then exit; // check $(LazarusDir)\fpc\bin\i386-win32\fpc.exe if CheckFile(GetForcedPathDelims('$(LazarusDir)\fpc\bin\$(TargetCPU)-$(TargetOS)\make.exe'),Result) then exit; end; // check history Files:=EnvironmentOptions.MakeFileHistory; if Files<>nil then for i:=0 to Files.Count-1 do if CheckFile(Files[i],Result) then exit; // check PATH {$IFDEF FreeBSD} AFilename:='gmake'; {$ELSE} AFilename:='make'; {$ENDIF} AFilename+=GetExecutableExt; if CheckFile(FindDefaultExecutablePath(AFilename),Result) then exit; // check common directories Files:=TStringList.Create; try GetDefaultMakeFilenames(Files); for i:=0 to Files.Count-1 do if CheckFile(Files[i],Result) then exit; finally Files.Free; end; finally EnvironmentOptions.MakeFilename:=OldMakeFilename; end; end; function GetValueFromPrimaryConfig(OptionFilename, Path: string): string; begin if not FilenameIsAbsolute(OptionFilename) then OptionFilename:=AppendPathDelim(GetPrimaryConfigPath)+OptionFilename; Result:=GetValueFromIDEConfig(OptionFilename,Path); end; function GetValueFromSecondaryConfig(OptionFilename, Path: string): string; begin if not FilenameIsAbsolute(OptionFilename) then OptionFilename:=AppendPathDelim(GetSecondaryConfigPath)+OptionFilename; Result:=GetValueFromIDEConfig(OptionFilename,Path); end; function GetValueFromIDEConfig(OptionFilename, Path: string): string; var XMLConfig: TXMLConfig; begin Result:=''; 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(['GetValueFromIDEConfig File='+OptionFilename+': '+E.Message]); end; end; end; end; { TSDFileInfoList } function TSDFileInfoList.AddNewItem(aFilename, aCaption: string): TSDFileInfo; begin Result:=TSDFileInfo.Create; Result.Filename:=aFilename; Result.Caption:=aCaption; Add(Result); end; function TSDFileInfoList.CaptionExists(aCaption: string): boolean; var i: Integer; begin Result:=false; for i:=0 to Count-1 do if CompareFilenames(aCaption,TSDFileInfo(Items[i]).Caption)=0 then exit(true); end; function TSDFileInfoList.BestDir: TSDFileInfo; begin if Count > 0 then Result:=TSDFileInfo(Items[Count-1]) else Result:=Nil; end; initialization {$IFDEF MSWindows} DefaultFPCTarget:= GetCompiledTargetCPU + '-' + GetCompiledTargetOS; DefaultFPCVersion:= {$I %FPCVERSION%}; DefaultDrive := ExtractFileDrive(ProgramDirectory); {$ENDIF} end.