mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 02:16:14 +02:00
implemented creating compiler option string for packages
git-svn-id: trunk@3412 -
This commit is contained in:
parent
74beb6a945
commit
40f7bb5562
147
ide/ideprocs.pp
147
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;
|
||||
|
Loading…
Reference in New Issue
Block a user