improved project: recognizing if filename was fixed before pathdelim changed

git-svn-id: trunk@6564 -

components/codetools/fileprocs.pas

@@ -59,7 +59,9 @@ function CompareFileExt(const Filename, Ext: string;
 function GetFilenameOnDisk(const AFilename: string): string;
 function DirPathExists(DirectoryName: string): boolean;
 function ExtractFileNameOnly(const AFilename: string): string;
-function FilenameIsAbsolute(TheFilename: string):boolean;
+function FilenameIsAbsolute(const TheFilename: string):boolean;
+function FilenameIsWinAbsolute(const TheFilename: string):boolean;
+function FilenameIsUnixAbsolute(const TheFilename: string):boolean;
 function ForceDirectory(DirectoryName: string): boolean;
 procedure CheckIfFileIsExecutable(const AFilename: string);
 function FileIsExecutable(const AFilename: string): boolean;
@@ -215,18 +217,28 @@ begin
   Result:=copy(Result,1,length(Result)-ExtLen);
 end;
 
-function FilenameIsAbsolute(TheFilename: string):boolean;
+function FilenameIsAbsolute(const TheFilename: string):boolean;
 begin
-  DoDirSeparators(TheFilename);
   {$IFDEF win32}
   // windows
+  Result:=FilenameIsWinAbsolute(TheFilename);
+  {$ELSE}
+  // unix
+  Result:=FilenameIsUnixAbsolute(TheFilename);
+  {$ENDIF}
+end;
+
+function FilenameIsWinAbsolute(const TheFilename: string): boolean;
+begin
   Result:=((length(TheFilename)>=2) and (TheFilename[1] in ['A'..'Z','a'..'z'])
            and (TheFilename[2]=':'))
      or ((length(TheFilename)>=2)
          and (TheFilename[1]='\') and (TheFilename[2]='\'));
-  {$ELSE}
+end;
+
+function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
+begin
   Result:=(TheFilename<>'') and (TheFilename[1]='/');
-  {$ENDIF}
 end;
 
 function GetFilenameOnDisk(const AFilename: string): string;

ide/project.pp

@@ -2266,24 +2266,36 @@ begin
 end;
 
 procedure TProject.OnLoadSaveFilename(var AFilename: string; Load:boolean);
-var ProjectPath:string;
+var
+  ProjectPath:string;
+  FileWasAbsolute: Boolean;
 begin
   if AFileName='' then exit;
   ProjectPath:=ProjectDirectory;
   if ProjectPath='' then ProjectPath:=GetCurrentDir;
-  if fPathDelimChanged then
+  //debugln('TProject.OnLoadSaveFilename A "',AFilename,'"');
+  if not fPathDelimChanged then begin
+    FileWasAbsolute:=FilenameIsAbsolute(AFileName);
+  end else begin
+    if PathDelim='\' then
+      // PathDelim changed from '/' to '\'
+      FileWasAbsolute:=FilenameIsUnixAbsolute(AFileName)
+    else
+      // PathDelim changed from '\' to '/'
+      FileWasAbsolute:=FilenameIsWinAbsolute(AFileName);
     DoDirSeparators(AFilename);
+  end;
   AFilename:=TrimFilename(AFilename);
   if Load then begin
     // make filename absolute
-    if (AFilename<>'') and (not FilenameIsAbsolute(AFilename)) then
+    if not FileWasAbsolute then
       AFilename:=TrimFilename(ProjectPath+AFilename);
   end else begin
     // try making filename relative to project file
-    if (AFilename<>'') and FilenameIsAbsolute(AFilename)
+    if FileWasAbsolute and FileIsInPath(AFilename,ProjectPath) then
-    and FileIsInPath(AFilename,ProjectPath) then
       AFilename:=CreateRelativePath(AFilename,ProjectPath);
   end;
+  //debugln('TProject.OnLoadSaveFilename END "',AFilename,'" FileWasAbsolute=',dbgs(FileWasAbsolute));
 end;
 
 function TProject.RemoveProjectPathFromFilename(
@@ -3156,6 +3168,9 @@ end.
 
 {
   $Log$
+  Revision 1.175  2005/01/12 23:58:31  mattias
+  improved project: recognizing if filename was fixed before pathdelim changed
+
   Revision 1.174  2005/01/12 23:28:16  mattias
   implemented skipping debugger settings for publishing projects
 

lcl/fileutil.pas

@@ -33,7 +33,9 @@ function CompareFilenames(const Filename1, Filename2: string;
                           ResolveLinks: boolean): integer;
 function CompareFilenames(Filename1: PChar; Len1: integer;
   Filename2: PChar; Len2: integer; ResolveLinks: boolean): integer;
-function FilenameIsAbsolute(TheFilename: string):boolean;
+function FilenameIsAbsolute(const TheFilename: string):boolean;
+function FilenameIsWinAbsolute(const TheFilename: string):boolean;
+function FilenameIsUnixAbsolute(const TheFilename: string):boolean;
 procedure CheckIfFileIsExecutable(const AFilename: string);
 procedure CheckIfFileIsSymlink(const AFilename: string);
 function FileIsReadable(const AFilename: string): boolean;
@@ -116,6 +118,9 @@ end.
 
 {
   $Log$
+  Revision 1.5  2005/01/12 23:58:31  mattias
+  improved project: recognizing if filename was fixed before pathdelim changed
+
   Revision 1.4  2004/12/18 23:46:16  mattias
   added resurce strings for gtk file dlg
 

lcl/include/fileutil.inc

@@ -103,20 +103,32 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  function FilenameIsAbsolute(TheFilename: string):boolean;
+  function FilenameIsAbsolute(const TheFilename: string):boolean;
  ------------------------------------------------------------------------------}
-function FilenameIsAbsolute(TheFilename: string):boolean;
+function FilenameIsAbsolute(const TheFilename: string):boolean;
 begin
-  DoDirSeparators(TheFilename);
   {$IFDEF win32}
   // windows
-  Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and
+  Result:=FilenameIsWinAbsolute(TheFilename);
-     (upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
   {$ELSE}
-  Result:=(TheFilename<>'') and (TheFilename[1]='/');
+  // unix
+  Result:=FilenameIsUnixAbsolute(TheFilename);
   {$ENDIF}
 end;
 
+function FilenameIsWinAbsolute(const TheFilename: string): boolean;
+begin
+  Result:=((length(TheFilename)>=2) and (TheFilename[1] in ['A'..'Z','a'..'z'])
+           and (TheFilename[2]=':'))
+     or ((length(TheFilename)>=2)
+         and (TheFilename[1]='\') and (TheFilename[2]='\'));
+end;
+
+function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
+begin
+  Result:=(TheFilename<>'') and (TheFilename[1]='/');
+end;
+
 {------------------------------------------------------------------------------
   function FilenameIsPascalUnit(const Filename: string): boolean;
  ------------------------------------------------------------------------------}
@@ -1093,6 +1105,9 @@ end;
 
 {
   $Log$
+  Revision 1.9  2005/01/12 23:58:31  mattias
+  improved project: recognizing if filename was fixed before pathdelim changed
+
   Revision 1.8  2004/12/18 23:46:16  mattias
   added resurce strings for gtk file dlg