paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 04:39:41 +01:00
Code Issues Packages Projects Releases Wiki Activity

improved project: recognizing if filename was fixed before pathdelim changed

Browse Source 
git-svn-id: trunk@6564 -
This commit is contained in:
mattias 2005-01-12 23:58:31 +00:00
parent bc8c4be760
commit 7223913675
4 changed files with 64 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/codetools/fileprocs.pas
View File

@ -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;

25
ide/project.pp
View File

@ -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)
and FileIsInPath(AFilename,ProjectPath) then
if FileWasAbsolute 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

7
lcl/fileutil.pas
View File

@ -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

27
lcl/include/fileutil.inc
View File

@ -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
(upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
Result:=FilenameIsWinAbsolute(TheFilename);
{$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