diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index d433d64a2a..19e24e50c7 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -2299,8 +2299,7 @@ begin CurLazDir:=ChompPathDelim(LazarusDirectory); if not TTransferMacroList.StrHasMacros(CurLazDir) then begin BaseDir:=ExtractFilePath(ChompPathDelim(GetPrimaryConfigPath)); - if (CompareFilenames(BaseDir,CurLazDir)=0) - or FileIsInPath(CurLazDir,BaseDir) then begin + if PathIsInPath(CurLazDir,BaseDir) then begin // the pcp directory is in the lazarus directory // or the lazarus directory is a sibling or a sub dir of a sibling of the pcp // examples: diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index dead3972f4..814293027d 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -50,6 +50,7 @@ function CreateEmptyFile(const Filename: string): boolean; function FilenameIsPascalSource(const Filename: string): boolean; function ChompEndNumber(const s: string): string; function ShortDisplayFilename(const aFileName: string): string; +function PathIsInPath(const Path, Directory: string): boolean; // find file function FindFilesCaseInsensitive(const Directory, @@ -505,10 +506,7 @@ function GetNextUsedDirectoryInSearchPath(const SearchPath, begin while (NextStartPos<=length(SearchPath)) do begin Result:=GetNextDirectoryInSearchPath(SearchPath,NextStartPos); - if (Result<>'') - and ((CompareFilenames(Result,FilterDir)=0) - or FileIsInPath(Result,FilterDir)) - then + if (Result<>'') and PathIsInPath(Result,FilterDir) then exit; end; Result:='' @@ -723,6 +721,20 @@ begin Result := aFileName; end; +function PathIsInPath(const Path, Directory: string): boolean; +var + ExpPath: String; + ExpDir: String; + l: integer; +begin + if Path='' then exit(false); + ExpPath:=AppendPathDelim(ResolveDots(Path)); + ExpDir:=AppendPathDelim(ResolveDots(Directory)); + l:=length(ExpDir); + Result:=(l>0) and (length(ExpPath)>=l) and (ExpPath[l]=PathDelim) + and (CompareFilenames(ExpDir,LeftStr(ExpPath,l))=0); +end; + function FindFirstFileWithExt(const Directory, Ext: string): string; var FileInfo: TSearchRec; diff --git a/ide/main.pp b/ide/main.pp index f0a872900e..825279b66d 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -1409,7 +1409,7 @@ begin and (CheckFPCExeQuality(EnvironmentOptions.GetParsedCompilerFilename,Note, CodeToolBoss.CompilerDefinesCache.TestFilename)=sddqInvalid) then begin - debugln(['Warning: (lazarus) invalid compiler: ',EnvironmentOptions.GetParsedCompilerFilename]); + debugln(['Warning: (lazarus) invalid compiler: ',EnvironmentOptions.GetParsedCompilerFilename,' ',Note]); ShowSetupDialog:=true; end; @@ -1421,7 +1421,7 @@ begin if CheckFPCSrcDirQuality(EnvironmentOptions.GetParsedFPCSourceDirectory,Note, CfgCache.GetFPCVer)=sddqInvalid then begin - debugln(['Warning: (lazarus) invalid fpc source directory: ',EnvironmentOptions.GetParsedFPCSourceDirectory]); + debugln(['Warning: (lazarus) invalid fpc source directory: ',EnvironmentOptions.GetParsedFPCSourceDirectory,' ',Note]); ShowSetupDialog:=true; end; end; @@ -6763,7 +6763,7 @@ begin UnitOutputDirectory:=TrimFilename(WorkingDir+PathDelim+UnitOutputDirectory); if FilenameIsAbsolute(UnitOutputDirectory) then begin if (not DirPathExistsCached(UnitOutputDirectory)) then begin - if not FileIsInPath(UnitOutputDirectory,WorkingDir) then begin + if not PathIsInPath(UnitOutputDirectory,WorkingDir) then begin Result:=IDEQuestionDialog(lisCreateDirectory, Format(lisTheOutputDirectoryIsMissing, [UnitOutputDirectory]), mtConfirmation, [mrYes, lisCreateIt, @@ -6777,7 +6777,8 @@ begin end; end; if Project1.IsVirtual - and (FileIsInPath(UnitOutputDirectory,EnvironmentOptions.GetParsedTestBuildDirectory)) + and (PathIsInPath(UnitOutputDirectory, + EnvironmentOptions.GetParsedTestBuildDirectory)) then begin // clean up test units Result:=CleanUpTestUnitOutputDir(UnitOutputDirectory); @@ -6799,7 +6800,7 @@ begin if Result<>mrIgnore then exit(mrCancel); end; end else begin - if not FileIsInPath(AppendPathDelim(TargetExeDirectory)+'dummy',WorkingDir) + if not PathIsInPath(TargetExeDirectory,WorkingDir) then begin Result:=IDEQuestionDialog(lisCreateDirectory, Format(lisTheOutputDirectoryIsMissing, [TargetExeDirectory]), @@ -11734,12 +11735,12 @@ begin SaveDialog.FileName:=SaveAsFilename; // if this is a project file, start in project directory if AnUnitInfo.IsPartOfProject and (not Project1.IsVirtual) - and (not FileIsInPath(SaveDialog.InitialDir,Project1.Directory)) then + and (not PathIsInPath(SaveDialog.InitialDir,Project1.Directory)) then SaveDialog.InitialDir:=Project1.Directory; // if this is a package file, then start in package directory PkgDefaultDirectory:=PkgBoss.GetDefaultSaveDirectoryForFile(AnUnitInfo.Filename); if (PkgDefaultDirectory<>'') - and (not FileIsInPath(SaveDialog.InitialDir,PkgDefaultDirectory)) then + and (not PathIsInPath(SaveDialog.InitialDir,PkgDefaultDirectory)) then SaveDialog.InitialDir:=PkgDefaultDirectory; // show save dialog if (not SaveDialog.Execute) or (ExtractFileName(SaveDialog.Filename)='') then diff --git a/ide/sourcefilemanager.pas b/ide/sourcefilemanager.pas index aec618e946..f487b7f058 100644 --- a/ide/sourcefilemanager.pas +++ b/ide/sourcefilemanager.pas @@ -4602,13 +4602,13 @@ begin // if this is a project file, start in project directory if (AnUnitInfo=nil) or (AnUnitInfo.IsPartOfProject and (not Project1.IsVirtual) - and (not FileIsInPath(SaveDialog.InitialDir,Project1.Directory))) + and (not PathIsInPath(SaveDialog.InitialDir,Project1.Directory))) then begin SaveDialog.InitialDir:=Project1.Directory; end; // if this is a package file, then start in package directory APath:=PkgBoss.GetDefaultSaveDirectoryForFile(AFilename); - if (APath<>'') and (not FileIsInPath(SaveDialog.InitialDir,APath)) then + if (APath<>'') and (not PathIsInPath(SaveDialog.InitialDir,APath)) then SaveDialog.InitialDir:=APath; repeat @@ -5382,7 +5382,7 @@ begin OldLRSFilePath:=ExtractFilePath(LRSCode.Filename); NewLRSFilePath:=OldLRSFilePath; if FilenameIsAbsolute(OldFilePath) - and FileIsInPath(OldLRSFilePath,OldFilePath) then begin + and PathIsInPath(OldLRSFilePath,OldFilePath) then begin // resource code was in the same or in a sub directory of source // -> try to keep this relationship NewLRSFilePath:=NewFilePath