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

MG: fixed replacing form resources

Browse Source 
git-svn-id: trunk@3249 -
This commit is contained in:
lazarus 2002-08-27 08:21:30 +00:00
parent 86fa4833c4
commit 674a9771d9
3 changed files with 156 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
components/codetools/basiccodetools.pas
View File

@ -119,6 +119,8 @@ function ReadRawNextPascalAtom(const Source:string;
//----------------------------------------------------------------------------
// comments
function FindNextNonSpace(const ASource: string; StartPos: integer
): integer;
function FindCommentEnd(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
@ -171,6 +173,7 @@ function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
function CleanCodeFromComments(const DirtyCode: string;
NestedComments: boolean): string;
function TrimCodeSpace(const ACode: string): string;
function CodeIsOnlySpace(const ACode: string; FromPos, ToPos: integer): boolean;
//-----------------------------------------------------------------------------
@ -967,6 +970,17 @@ begin
if Result>MaxPos+1 then Result:=MaxPos+1;
end;
function FindNextNonSpace(const ASource: string; StartPos: integer
): integer;
var
SrcLen: integer;
begin
SrcLen:=length(ASource);
Result:=StartPos;
while (Result<=SrcLen) and (ASource[Result] in [' ',#9,#10,#13]) do
inc(Result);
end;
function FindCommentEnd(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
var
@ -1954,6 +1968,25 @@ begin
SetLength(Result,ResultPos-1);
end;
function CodeIsOnlySpace(const ACode: string; FromPos, ToPos: integer): boolean;
var
SrcLen: integer;
CodePos: integer;
begin
Result:=true;
SrcLen:=length(ACode);
if ToPos>SrcLen then ToPos:=SrcLen;
CodePos:=FromPos;
while (CodePos<=ToPos) do begin
if ACode[CodePos] in [' ',#9,#10,#13] then
inc(CodePos)
else begin
Result:=false;
exit;
end;
end;
end;
function CountNeededLineEndsToAddForward(const Src: string;
StartPos, MinLineEnds: integer): integer;
var c:char;

20
components/codetools/codetoolmanager.pas
View File

@ -252,6 +252,8 @@ type
function FindLFMFileName(Code: TCodeBuffer): string;
function FindNextResourceFile(Code: TCodeBuffer;
var LinkIndex: integer): TCodeBuffer;
function AddLazarusResourceHeaderComment(Code: TCodeBuffer;
const CommentText: string): boolean;
function FindLazarusResource(Code: TCodeBuffer;
const ResourceName: string): TAtomPosition;
function AddLazarusResource(Code: TCodeBuffer;
@ -1180,6 +1182,22 @@ begin
end;
end;
function TCodeToolManager.AddLazarusResourceHeaderComment(Code: TCodeBuffer;
const CommentText: string): boolean;
begin
Result:=false;
if not InitResourceTool then exit;
{$IFDEF CTDEBUG}
writeln('TCodeToolManager.AddLazarusResourceHeaderComment A ',Code.Filename,' CommentText=',CommentText);
{$ENDIF}
try
Result:=GetResourceTool.AddLazarusResourceHeaderComment(Code,
'{ '+CommentText+' }'+SourceChangeCache.BeautifyCodeOptions.LineEnd);
except
on e: Exception do HandleException(e);
end;
end;
function TCodeToolManager.FindLazarusResource(Code: TCodeBuffer;
const ResourceName: string): TAtomPosition;
begin
@ -1189,7 +1207,7 @@ begin
writeln('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
{$ENDIF}
try
Result:=GetResourceTool.FindLazarusResource(Code,ResourceName);
Result:=GetResourceTool.FindLazarusResource(Code,ResourceName,-1);
except
on e: Exception do HandleException(e);
end;

116
components/codetools/resourcecodetool.pas
View File

@ -40,12 +40,21 @@ type
procedure SetSource(ACode: TCodeBuffer);
public
// lazarus resources
function FindLazarusResourceHeaderComment(ResourceCode: TCodeBuffer
): TAtomPosition;
function AddLazarusResourceHeaderComment(ResourceCode: TCodeBuffer;
const Comment: string): boolean;
function FindLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName: string): TAtomPosition;
const ResourceName: string; StartPos: integer): TAtomPosition;
function FindAllLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName: string; StartPos: integer): TAtomList;
function AddLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName, ResourceData: string): boolean;
function RemoveLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName: string): boolean;
function RemoveLazarusResourceEx(ResourceCode: TCodeBuffer;
const ResourceName: string; AllExceptFirst: boolean;
var First: TAtomPosition): boolean;
end;
TResourceCodeToolError = class(Exception)
@ -68,8 +77,39 @@ begin
DoDeleteNodes;
end;
function TResourceCodeTool.FindLazarusResourceHeaderComment(
ResourceCode: TCodeBuffer): TAtomPosition;
begin
Result.StartPos:=-1;
Result.EndPos:=-1;
SetSource(ResourceCode);
Result.StartPos:=FindNextNonSpace(Src,1);
if (Result.StartPos<=SrcLen) and (Src[Result.StartPos]='{') then
Result.EndPos:=FindCommentEnd(Src,Result.StartPos,false)
else
Result.StartPos:=-1;
end;
function TResourceCodeTool.AddLazarusResourceHeaderComment(
ResourceCode: TCodeBuffer; const Comment: string): boolean;
var
InsertPos: TAtomPosition;
begin
Result:=true;
// find existing one
InsertPos:=FindLazarusResourceHeaderComment(ResourceCode);
if InsertPos.StartPos>0 then begin
// there is already a comment
// -> don't touch it
end else
ResourceCode.Insert(1,Comment);
end;
function TResourceCodeTool.FindLazarusResource(
ResourceCode: TCodeBuffer; const ResourceName: string): TAtomPosition;
ResourceCode: TCodeBuffer; const ResourceName: string;
StartPos: integer): TAtomPosition;
var
ResourceNameInPascal: string;
ResStartPos: integer;
@ -77,7 +117,11 @@ begin
Result.StartPos:=-1;
Result.EndPos:=-1;
SetSource(ResourceCode);
if StartPos>=1 then begin
CurPos.StartPos:=StartPos;
CurPos.EndPos:=StartPos;
end;
// search "LAZARUSRESOURCES.ADD('ResourceName',"
ResourceNameInPascal:=''''+UpperCaseStr(ResourceName)+'''';
repeat
@ -92,7 +136,7 @@ begin
if CurPos.Flag<>cafRoundBracketOpen then continue;
ReadNextAtom;
if UpAtomIs(ResourceNameInPascal) then begin
// resource found
// resource start found
Result.StartPos:=ResStartPos;
end;
UndoReadNextAtom;
@ -103,6 +147,7 @@ begin
exit;
end;
if (Result.StartPos>0) then begin
// resource end found
Result.EndPos:=CurPos.EndPos;
ReadNextAtom;
if CurPos.Flag=cafSemicolon then
@ -113,6 +158,20 @@ begin
until CurPos.StartPos>SrcLen;
end;
function TResourceCodeTool.FindAllLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName: string; StartPos: integer): TAtomList;
var
ResourcePos: TAtomPosition;
begin
Result:=TAtomList.Create;
repeat
ResourcePos:=FindLazarusResource(ResourceCode,ResourceName,StartPos);
if ResourcePos.StartPos<1 then break;
Result.Add(ResourcePos);
StartPos:=ResourcePos.EndPos;
until false;
end;
function TResourceCodeTool.AddLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName, ResourceData: string): boolean;
var
@ -121,8 +180,8 @@ var
NewResData: string;
begin
Result:=false;
// first try to find an old resource
InsertAtom:=FindLazarusResource(ResourceCode,ResourceName);
// try to find an old resource and delete all doubles
Result:=RemoveLazarusResourceEx(ResourceCode,ResourceName,true,InsertAtom);
if InsertAtom.StartPos<1 then begin
// not found -> add at end of file
InsertAtom.StartPos:=ResourceCode.SourceLength+1;
@ -130,8 +189,13 @@ begin
end;
InsertAtom.StartPos:=BasicCodeTools.FindLineEndOrCodeInFrontOfPosition(Src,
InsertAtom.StartPos,1,false,true)+1;
if CodeIsOnlySpace(Src,1,InsertAtom.StartPos-1) then
InsertAtom.StartPos:=1;
InsertAtom.EndPos:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
InsertAtom.EndPos,SrcLen,false);
if CodeIsOnlySpace(Src,InsertAtom.EndPos+1,SrcLen) then
InsertAtom.EndPos:=SrcLen+1;
NewResData:=ResourceData;
i:=length(NewResData);
while (i>1) and (NewResData[i] in [' ',#10,#13]) do
@ -159,14 +223,42 @@ end;
function TResourceCodeTool.RemoveLazarusResource(ResourceCode: TCodeBuffer;
const ResourceName: string): boolean;
var OldAtom: TAtomPosition;
var
FirstResPos: TAtomPosition;
begin
Result:=RemoveLazarusResourceEx(ResourceCode,ResourceName,false,FirstResPos);
end;
function TResourceCodeTool.RemoveLazarusResourceEx(ResourceCode: TCodeBuffer;
const ResourceName: string; AllExceptFirst: boolean; var First: TAtomPosition
): boolean;
var
ResourcePositions: TAtomList;
CurResPos: TAtomPosition;
i, FirstIndex: integer;
begin
Result:=true;
OldAtom:=FindLazarusResource(ResourceCode,ResourceName);
if (OldAtom.StartPos<1) then exit;
OldAtom.EndPos:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
OldAtom.EndPos,SrcLen,false);
ResourceCode.Delete(OldAtom.StartPos,OldAtom.EndPos);
ResourcePositions:=FindAllLazarusResource(ResourceCode,ResourceName,-1);
try
if AllExceptFirst then
FirstIndex:=1
else
FirstIndex:=0;
for i:=ResourcePositions.Count-1 downto FirstIndex do begin
CurResPos:=ResourcePositions[i];
CurResPos.EndPos:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
CurResPos.EndPos,SrcLen,false);
ResourceCode.Delete(CurResPos.StartPos,CurResPos.EndPos-CurResPos.StartPos);
end;
if ResourcePositions.Count>0 then begin
First:=ResourcePositions[0];
end else begin
First.StartPos:=-1;
First.EndPos:=-1;
end;
finally
ResourcePositions.Free;
end;
end;
end.