diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index 6b49994ea8..ac04f6ee23 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -100,6 +100,8 @@ function FilenameIsFormText(const Filename: string): boolean; function MergeSearchPaths(const OldSearchPath, AddSearchPath: string): string; function SearchDirectoryInSearchPath(const SearchPath, Directory: string; DirStartPos: integer): integer; +function CreateRelativePath(const Filename, BaseDirectory: string): string; +function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): string; // XMLConfig procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStringList; @@ -126,6 +128,7 @@ function CrossReplaceChars(const Src: string; PrefixChar: char; function SimpleSyntaxToRegExpr(const Src: string): string; function NameToValidIdentifier(const s: string): string; function BinaryStrToText(const s: string): string; +function SplitString(const s: string; Delimiter: char): TStringList; // translation/internationalization/localization procedure TranslateResourceStrings(const BaseDirectory, CustomLang: string); @@ -329,6 +332,122 @@ begin end; end; +function CreateRelativePath(const Filename, BaseDirectory: string): string; +var + FileNameLength: Integer; + BaseDirLen: Integer; + MinLen: Integer; + SamePos: Integer; + UpDirCount: Integer; + BaseDirPos: Integer; + ResultPos: Integer; + i: Integer; + FileNameRestLen: Integer; +begin + Result:=Filename; + if (BaseDirectory='') or (Filename='') then exit; + // check for different windows file drives + if (AnsiCompareText(ExtractFileDrive(Filename), + ExtractFileDrive(BaseDirectory))<>0) + then + exit; + + FileNameLength:=length(Filename); + BaseDirLen:=length(BaseDirectory); + + // skip matching directories + MinLen:=FileNameLength; + if MinLen>BaseDirLen then MinLen:=BaseDirLen; + SamePos:=1; + while (SamePos<=MinLen) do begin + {$IFDEF win32} + if AnsiStrLIComp(@FileName[SamePos],@BaseDirectory[SamePos],1)=0 + {$ELSE} + if FileName[SamePos]=BaseDirectory[SamePos] + {$ENDIF} + then + inc(SamePos) + else + break; + end; + if (SamePos>MinLen) + and (((SamePos<=BaseDirLen) and (BaseDirectory[SamePos]=PathDelim)) + or ((SamePos<=FileNameLength) and (Filename[SamePos]=PathDelim)) + or (BaseDirLen=FileNameLength)) + then begin + // Filename lies in BaseDirectory + // or Filename is parent directory of BaseDirectory + // or Filename is BaseDirectory + end else begin + // difference found -> step back to path delimiter + repeat + dec(SamePos); + if (SamePos<1) then exit; + until (FileName[SamePos]=PathDelim); + end; + if (SamePos=1) and (Filename[1]=PathDelim) then exit; + + // calculate needed up directories + UpDirCount:=0; + BaseDirPos:=SamePos+1; + while (BaseDirPos<=BaseDirLen) do begin + if BaseDirectory[BaseDirPos]=PathDelim then inc(UpDirCount); + inc(BaseDirPos); + end; + if BaseDirectory[BaseDirLen]<>PathDelim then inc(UpDirCount); + + // create relative filename + FileNameRestLen:=FileNameLength-SamePos; + SetLength(Result,3*UpDirCount+FileNameRestLen); + ResultPos:=1; + for i:=1 to UpDirCount do begin + Result[ResultPos]:='.'; + Result[ResultPos+1]:='.'; + Result[ResultPos+2]:=PathDelim; + inc(ResultPos,3); + end; + if FileNameRestLen>0 then + Move(Filename[SamePos+1],Result[ResultPos],FileNameRestLen); +end; + +function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string + ): string; +var + PathLen: Integer; + EndPos: Integer; + StartPos: Integer; + CurDir: String; + NewCurDir: String; + DiffLen: Integer; +begin + Result:=SearchPath; + if (SearchPath='') or (BaseDirectory='') then exit; + + PathLen:=length(Result); + EndPos:=1; + while EndPos<=PathLen do begin + StartPos:=EndPos; + while (Result[StartPos]=';') do begin + inc(StartPos); + if StartPos>PathLen then exit; + end; + EndPos:=StartPos; + while (EndPos<=PathLen) and (Result[EndPos]<>';') do inc(EndPos); + CurDir:=copy(Result,StartPos,EndPos-StartPos); + if FilenameIsAbsolute(CurDir) then begin + NewCurDir:=CreateRelativePath(CurDir,BaseDirectory); + if NewCurDir<>CurDir then begin + DiffLen:=length(NewCurDir)-length(CurDir); + Result:=copy(Result,1,StartPos-1)+NewCurDir + +copy(Result,EndPos,PathLen-EndPos+1); + inc(EndPos,DiffLen); + inc(PathLen,DiffLen); + end; + end; + StartPos:=EndPos; + end; +end; + procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStringList; const Path: string); begin @@ -1039,6 +1158,32 @@ begin RaiseException('ERROR: BinaryStrToText: '+IntToStr(NewLen)+'<>'+IntToStr(NewPos-1)); end; +{------------------------------------------------------------------------------- + function SplitString(const s: string; Delimiter: char): TStringList; +-------------------------------------------------------------------------------} +function SplitString(const s: string; Delimiter: char): TStringList; +var + SLen: Integer; + StartPos: Integer; + EndPos: Integer; +begin + Result:=TStringList.Create; + SLen:=length(s); + StartPos:=1; + EndPos:=1; + repeat + if (EndPos<=sLen) and (s[EndPos]<>Delimiter) then + inc(EndPos) + else begin + if EndPos>StartPos then + Result.Add(copy(s,StartPos,EndPos-StartPos)); + StartPos:=EndPos+1; + if StartPos>sLen then exit; + inc(EndPos); + end; + until false; +end; + {------------------------------------------------------------------------------- ConvertSpecialFileChars @@ -1510,7 +1655,7 @@ begin c:=Src[SrcPos]; if (c<>PrefixChar) then begin if System.Pos(c,SpecialChars)>=1 then begin - // in front of each SpecialChars will be PrefixChar inserted + // in front of each SpecialChar will be a PrefixChar inserted inc(DestLen); NeedsChange:=true; end;