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

codetools: changed RetypeClassVariables parameter to tree

Browse Source 
git-svn-id: trunk@24219 -
This commit is contained in:
mattias 2010-03-26 12:24:47 +00:00
parent 4e55c6562f
commit d3f232387d
3 changed files with 45 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/codetools/codetoolmanager.pas
View File

@ -663,7 +663,8 @@ type
const AClassName, OldVariableName, NewVarName, const AClassName, OldVariableName, NewVarName,
VarType: shortstring; ErrorOnClassNotFound: boolean): boolean; VarType: shortstring; ErrorOnClassNotFound: boolean): boolean;
function RetypeClassVariables(Code: TCodeBuffer; const AClassName: string; function RetypeClassVariables(Code: TCodeBuffer; const AClassName: string;
ListOfReTypes: TStrings; ErrorOnClassNotFound: boolean): boolean; ListOfReTypes: TStringToStringTree;
ErrorOnClassNotFound: boolean): boolean;
function FindDanglingComponentEvents(Code: TCodeBuffer; function FindDanglingComponentEvents(Code: TCodeBuffer;
const AClassName: string; const AClassName: string;
RootComponent: TComponent; ExceptionOnClassNotFound, RootComponent: TComponent; ExceptionOnClassNotFound,
@ -4609,7 +4610,7 @@ begin
end; end;
function TCodeToolManager.RetypeClassVariables(Code: TCodeBuffer; function TCodeToolManager.RetypeClassVariables(Code: TCodeBuffer;
const AClassName: string; ListOfReTypes: TStrings; const AClassName: string; ListOfReTypes: TStringToStringTree;
ErrorOnClassNotFound: boolean): boolean; ErrorOnClassNotFound: boolean): boolean;
begin begin
Result:=false; Result:=false;

8
components/codetools/examples/retypepublishedvars.lpr
View File

@ -36,7 +36,7 @@ const
var var
Code: TCodeBuffer; Code: TCodeBuffer;
Filename: String; Filename: String;
ListOfTypes: TStringList; ListOfTypes: TStringToStringTree;
begin begin
if (ParamCount>=1) and (Paramcount<>3) then begin if (ParamCount>=1) and (Paramcount<>3) then begin
writeln('Usage:'); writeln('Usage:');
@ -59,9 +59,9 @@ begin
raise Exception.Create('loading failed '+Filename); raise Exception.Create('loading failed '+Filename);
// complete code // complete code
ListOfTypes:=TStringList.Create; ListOfTypes:=TStringToStringTree.Create(false);
ListOfTypes.Values['TExButton']:='TButton'; ListOfTypes['TExButton']:='TButton';
ListOfTypes.Values['TExEdit']:='TEdit'; ListOfTypes['TExEdit']:='TEdit';
if CodeToolBoss.RetypeClassVariables(Code,'TForm1',ListOfTypes,true) if CodeToolBoss.RetypeClassVariables(Code,'TForm1',ListOfTypes,true)
then begin then begin
writeln('Sucess:'); writeln('Sucess:');

84
components/codetools/stdcodetools.pas
View File

@ -188,7 +188,7 @@ type
WithProperties, WithAncestors: boolean; WithProperties, WithAncestors: boolean;
out TreeOfCodeTreeNodeExtension: TAVLTree): boolean; out TreeOfCodeTreeNodeExtension: TAVLTree): boolean;
function RetypeClassVariables(const AClassName: string; function RetypeClassVariables(const AClassName: string;
ListOfTypes: TStrings; ExceptionOnClassNotFound: boolean; ListOfTypes: TStringToStringTree; ExceptionOnClassNotFound: boolean;
SourceChangeCache: TSourceChangeCache): boolean; SourceChangeCache: TSourceChangeCache): boolean;
function FindDanglingComponentEvents(const TheClassName: string; function FindDanglingComponentEvents(const TheClassName: string;
RootComponent: TComponent; ExceptionOnClassNotFound, RootComponent: TComponent; ExceptionOnClassNotFound,
@ -4905,14 +4905,12 @@ begin
end; end;
function TStandardCodeTool.RetypeClassVariables(const AClassName: string; function TStandardCodeTool.RetypeClassVariables(const AClassName: string;
ListOfTypes: TStrings; ExceptionOnClassNotFound: boolean; ListOfTypes: TStringToStringTree; ExceptionOnClassNotFound: boolean;
SourceChangeCache: TSourceChangeCache): boolean; SourceChangeCache: TSourceChangeCache): boolean;
var var
ClassNode: TCodeTreeNode; ClassNode: TCodeTreeNode;
Node: TCodeTreeNode; Node: TCodeTreeNode;
TypeNode: TCodeTreeNode; TypeNode: TCodeTreeNode;
i: Integer;
OldToNew: TStringToStringTree;
OldType: String; OldType: String;
NewType: string; NewType: string;
HasChanged: Boolean; HasChanged: Boolean;
@ -4927,53 +4925,47 @@ begin
else else
exit; exit;
end; end;
if (ListOfTypes=nil) or (ListOfTypes.Count=0) then exit(true); if (ListOfTypes=nil) or (ListOfTypes.Tree.Count=0) then exit(true);
OldToNew:=TStringToStringTree.Create(false); HasChanged:=false;
try BuildSubTreeForClass(ClassNode);
for i:=0 to ListOfTypes.Count-1 do Node:=ClassNode.FirstChild;
OldToNew.Add(ListOfTypes.Names[i],ListOfTypes.ValueFromIndex[i]); while (Node<>nil) and (Node.HasAsParent(ClassNode)) do begin
if (Node.Desc=ctnVarDefinition) and (Node.FirstChild<>nil) then begin
HasChanged:=false; TypeNode:=Node.FirstChild;
BuildSubTreeForClass(ClassNode); if TypeNode.Desc=ctnIdentifier then begin
Node:=ClassNode.FirstChild; MoveCursorToNodeStart(TypeNode);
while (Node<>nil) and (Node.HasAsParent(ClassNode)) do begin ReadNextAtom;
if (Node.Desc=ctnVarDefinition) and (Node.FirstChild<>nil) then begin ReadNextAtom;
TypeNode:=Node.FirstChild; if CurPos.Flag=cafPoint then begin
if TypeNode.Desc=ctnIdentifier then begin // skip unitname
MoveCursorToNodeStart(TypeNode);
ReadNextAtom; ReadNextAtom;
ReadNextAtom; end else begin
if CurPos.Flag=cafPoint then begin UndoReadNextAtom;
// skip unitname end;
ReadNextAtom; // cursor is now on identifier
end else begin OldType:=GetAtom;
UndoReadNextAtom; if ListOfTypes.Contains(OldType) then begin
end; NewType:=ListOfTypes[OldType];
// cursor is now on identifier if OldType<>NewType then begin
OldType:=GetAtom; // change type (or case)
if OldToNew.Contains(OldType) then begin if not HasChanged then begin
NewType:=OldToNew[OldType]; HasChanged:=true;
if OldType<>NewType then begin SourceChangeCache.MainScanner:=Scanner;
// change type
if not HasChanged then begin
HasChanged:=true;
SourceChangeCache.MainScanner:=Scanner;
end;
if not SourceChangeCache.Replace(gtNone,gtNone,
CurPos.StartPos,CurPos.EndPos,NewType) then exit(false);
end; end;
if not SourceChangeCache.Replace(gtNone,gtNone,
CurPos.StartPos,CurPos.EndPos,NewType)
then
exit(false);
end; end;
end; end;
Node:=Node.NextSkipChilds; end;
end else Node:=Node.NextSkipChilds;
Node:=Node.Next; end else
end; Node:=Node.Next;
if HasChanged then begin end;
if not SourceChangeCache.Apply then exit; if HasChanged then begin
end; if not SourceChangeCache.Apply then exit;
finally
OldToNew.Free;
end; end;
Result:=true; Result:=true;
end; end;