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

codetools, LCL: fixed CeateRelativePath

Browse Source 
git-svn-id: trunk@10264 -
This commit is contained in:
mattias 2006-11-30 00:17:55 +00:00
parent 198bbb69ce
commit 0999d7c7a8
3 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/codetools/fileprocs.pas
View File

@ -874,11 +874,14 @@ var
begin
Result:=Filename;
if (BaseDirectory='') or (Filename='') then exit;
{$IFDEF MSWindows}
// check for different windows file drives
if (CompareText(ExtractFileDrive(Filename),
ExtractFileDrive(BaseDirectory))<>0)
then
exit;
{$ENDIF}
FileNameLength:=length(Filename);
BaseDirLen:=length(BaseDirectory);
@ -919,10 +922,12 @@ begin
UpDirCount:=0;
BaseDirPos:=SamePos+1;
while (BaseDirPos<=BaseDirLen) do begin
if BaseDirectory[BaseDirPos]=PathDelim then inc(UpDirCount);
if (BaseDirectory[BaseDirPos]=PathDelim) then
inc(UpDirCount);
inc(BaseDirPos);
end;
if BaseDirectory[BaseDirLen]<>PathDelim then inc(UpDirCount);
if (SamePos<BaseDirLen) and (BaseDirectory[BaseDirLen]<>PathDelim) then
inc(UpDirCount);
// create relative filename
FileNameRestLen:=FileNameLength-SamePos;
@ -938,7 +943,7 @@ begin
Move(Filename[SamePos+1],Result[ResultPos],FileNameRestLen);
// use '.' for an Filename=BaseDirectory
if (Result='') and (Filename<>'') and UsePointDirectory then
if UsePointDirectory and (Result='') and (Filename<>'') then
Result:='.';
end;

10
ide/environmentopts.pp
View File

@ -264,6 +264,8 @@ type
var Abort: boolean): string;
function MacroFuncLazarusDir(const s:string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFuncExeExt(const s:string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFuncLanguageID(const s:string; const Data: PtrInt;
var Abort: boolean): string;
function MacroFuncLanguageName(const s:string; const Data: PtrInt;
@ -1511,6 +1513,8 @@ begin
lisFreePascalSourceDirectory,@MacroFuncFPCSrcDir,[]));
AMacroList.Add(TTransferMacro.Create('LazarusDir','',
lisLazarusDirectory,@MacroFuncLazarusDir,[]));
AMacroList.Add(TTransferMacro.Create('ExeExt','',
lisLazarusDirectory,@MacroFuncExeExt,[]));
AMacroList.Add(TTransferMacro.Create('LanguageID','',
lisLazarusLanguageID,@MacroFuncLanguageID,[]));
AMacroList.Add(TTransferMacro.Create('LanguageName','',
@ -1539,6 +1543,12 @@ begin
Result:=LazarusDirectory;
end;
function TEnvironmentOptions.MacroFuncExeExt(const s: string;
const Data: PtrInt; var Abort: boolean): string;
begin
Result:=GetExecutableExt;
end;
function TEnvironmentOptions.MacroFuncLanguageID(const s: string;
const Data: PtrInt; var Abort: boolean): string;
begin

11
lcl/include/fileutil.inc
View File

@ -894,11 +894,14 @@ var
begin
Result:=Filename;
if (BaseDirectory='') or (Filename='') then exit;
{$IFDEF MSWindows}
// check for different windows file drives
if (CompareText(ExtractFileDrive(Filename),
ExtractFileDrive(BaseDirectory))<>0)
ExtractFileDrive(BaseDirectory))<>0)
then
exit;
{$ENDIF}
FileNameLength:=length(Filename);
BaseDirLen:=length(BaseDirectory);
@ -939,10 +942,12 @@ begin
UpDirCount:=0;
BaseDirPos:=SamePos+1;
while (BaseDirPos<=BaseDirLen) do begin
if BaseDirectory[BaseDirPos]=PathDelim then inc(UpDirCount);
if (BaseDirectory[BaseDirPos]=PathDelim) then
inc(UpDirCount);
inc(BaseDirPos);
end;
if BaseDirectory[BaseDirLen]<>PathDelim then inc(UpDirCount);
if (SamePos<BaseDirLen) and (BaseDirectory[BaseDirLen]<>PathDelim) then
inc(UpDirCount);
// create relative filename
FileNameRestLen:=FileNameLength-SamePos;