MG: fixed replacing form resources

git-svn-id: trunk@3249 -

components/codetools/basiccodetools.pas

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

components/codetools/codetoolmanager.pas

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

components/codetools/resourcecodetool.pas

@@ -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
+  // try to find an old resource and delete all doubles
-  InsertAtom:=FindLazarusResource(ResourceCode,ResourceName);
+  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);
+  ResourcePositions:=FindAllLazarusResource(ResourceCode,ResourceName,-1);
-  if (OldAtom.StartPos<1) then exit;
+  try
-  OldAtom.EndPos:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
+    if AllExceptFirst then
-                         OldAtom.EndPos,SrcLen,false);
+      FirstIndex:=1
-  ResourceCode.Delete(OldAtom.StartPos,OldAtom.EndPos);
+    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.