LazFileUtils: (Try)CreateRelativePath: implement option to control wether Dest and Source

must always share a common base folder (being not the root directory).
For CreateRelativePath it defaults to True for backwards compatibility.

git-svn-id: trunk@41452 -

components/lazutils/fileutil.inc

@@ -557,9 +557,9 @@ begin
 end;
 
 function CreateRelativePath(const Filename, BaseDirectory: string;
-  UsePointDirectory: boolean): string;
+                            UsePointDirectory: boolean; AlwaysRequireSharedBaseFolder: Boolean): string;
 begin
-  Result := LazFileUtils.CreateRelativePath(FileName, BaseDirectory, UsePointDirectory);
+  Result := LazFileUtils.CreateRelativePath(FileName, BaseDirectory, UsePointDirectory, AlwaysRequireSharedBaseFolder);
 end;
 
 function CreateAbsolutePath(const Filename, BaseDirectory: string): string;

components/lazutils/fileutil.pas

@@ -109,7 +109,7 @@ function CleanAndExpandFilename(const Filename: string): string; inline;
 function CleanAndExpandDirectory(const Filename: string): string; inline;
 function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string;
 function CreateRelativePath(const Filename, BaseDirectory: string;
-                            UsePointDirectory: boolean = false): string; inline;
+                            UsePointDirectory: boolean = false; AlwaysRequireSharedBaseFolder: Boolean = True): string; inline;
 function CreateAbsolutePath(const Filename, BaseDirectory: string): string;
 function FileIsInPath(const Filename, Path: string): boolean;
 function FileIsInDirectory(const Filename, Directory: string): boolean;

components/lazutils/lazfileutils.inc

@@ -153,6 +153,9 @@ end;
   - if both Dest and Source are relative they must at least share their base directory
   - Double PathDelims are ignored (unless they are part of the UNC convention)
 
+  - if UsePointDirectory is True and Result is True then if RelPath is Empty string, RelPath becomes '.'
+  - if AlwaysRequireSharedBaseFolder is False then Absolute filenames need not share a basefolder
+
   Examples:
   - Dest = /foo/bar Source = /foo Result = True RelPath = bar
   - Dest = /foo///bar Source = /foo// Result = True RelPath = bar
@@ -164,9 +167,12 @@ end;
   - Dest = c:foo Source = c:bar Result = False (no expanding)
   - Dest = c:\foo Source = d:\bar Result is False (different drives)
   - Dest = \foo Source = foo (Windows) Result is False (too ambiguous to guess what this should mean)
+  - Dest = /foo Source = /bar AlwaysRequireSharedBaseFolder = True Result = False
+  - Dest = /foo Source = /bar AlwaysRequireSharedBaseFolder = False Result = True RelPath = ../foo
 }
 
-function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean; out RelPath: String): Boolean;
+function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean;
+                               AlwaysRequireSharedBaseFolder: Boolean; out RelPath: String): Boolean;
 Const
   MaxDirs = 129;
 Type
@@ -296,9 +302,10 @@ begin
   end;
 
   //debugln('TryCreaterelativePath: SharedFolders = ',DbgS(SharedFolders));
-  if not IsAbs and (SharedFolders = 0) and not ((CmpDestLen = 0) and (CmpSourceLen = 0)) then
+  if (SharedFolders = 0) and ((not IsAbs) or AlwaysRequireSharedBaseFolder) and not ((CmpDestLen = 0) and (CmpSourceLen = 0)) then
   begin
-    //debguln('TryCreaterelativePath: FAIL: IsAbs = FALSE, SharedFolders = 0, CmpDestLen = ',cmpdestlen,' CmpSourceLen = ',CmpSourceLen);
+    //debguln('TryCreaterelativePath: FAIL: IsAbs = ',DbgS(IsAs),' AlwaysRequireSharedBaseFolder = ',DbgS(AlwaysRequireSharedBaseFolder),
+    //' SharedFolders = 0, CmpDestLen = ',DbgS(cmpdestlen),' CmpSourceLen = ',DbgS(CmpSourceLen));
     Exit;
   end;
   LevelsBack := SourceCount - SharedFolders;
@@ -326,17 +333,30 @@ begin
       RelPath := RelPath + DestDirs[DestCount + 1 - i];
     end;
   end;
+  {
+  // This is a lame way to pass the tests in our testsuite,
+  // however it is internally inconsistent: why add a PathDelim only if RelPath ends in dots?
+  if (RelPath = '') then
+  begin
+    if UsePointDirectory then RelPath := '.'
+  end
+  else
+  begin
+    if (RelPath[Length(RelPath)] = '.') then RelPath := AppendPathDelim(RelPath);
+  end;
+  }
   if UsePointDirectory and (RelPath = '') then
     RelPath := '.'; // Dest = Source
+
   Result := True;
 end;
 
 function CreateRelativePath(const Filename, BaseDirectory: string;
-  UsePointDirectory: boolean): string;
+  UsePointDirectory: boolean;  AlwaysRequireSharedBaseFolder: Boolean): string;
 var
   RelPath: String;
 begin
   Result:=Filename;
-  if TryCreateRelativePath(FileName, Basedirectory, UsePointDirectory, RelPath) then
+  if TryCreateRelativePath(FileName, Basedirectory, UsePointDirectory, AlwaysRequireSharedBaseFolder, RelPath) then
     Result := RelPath;
 end;

components/lazutils/lazfileutils.pas

@@ -56,9 +56,10 @@ function CleanAndExpandFilename(const Filename: string): string; // empty string
 function CleanAndExpandDirectory(const Filename: string): string; // empty string returns current directory
 function TrimAndExpandFilename(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
 function TrimAndExpandDirectory(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
-function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean; out RelPath: String): Boolean;
+function TryCreateRelativePath(const Dest, Source: String; UsePointDirectory: boolean;
+                               AlwaysRequireSharedBaseFolder: Boolean; out RelPath: String): Boolean;
 function CreateRelativePath(const Filename, BaseDirectory: string;
-                            UsePointDirectory: boolean = false): string;
+                            UsePointDirectory: boolean = false; AlwaysRequireSharedBaseFolder: Boolean = True): string;
 function FileIsInPath(const Filename, Path: string): boolean;
 function AppendPathDelim(const Path: string): string;
 function ChompPathDelim(const Path: string): string;