codetools: added RetypeClassVariables

git-svn-id: trunk@24215 -

.gitattributes

@@ -476,6 +476,8 @@ components/codetools/examples/removeemptymethods.lpi svneol=native#text/plain
 components/codetools/examples/removeemptymethods.lpr svneol=native#text/plain
 components/codetools/examples/replaceresourcedirectives.lpi svneol=native#text/plain
 components/codetools/examples/replaceresourcedirectives.lpr svneol=native#text/plain
+components/codetools/examples/retypepublishedvars.lpi svneol=native#text/plain
+components/codetools/examples/retypepublishedvars.lpr svneol=native#text/plain
 components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/abstractclass1.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/addeventexample.pas svneol=native#text/plain
@@ -491,6 +493,7 @@ components/codetools/examples/scanexamples/methodjump1.pas svneol=native#text/pl
 components/codetools/examples/scanexamples/missingh2pasdirectives.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/modemacpas.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/overloadedfunction.pas svneol=native#text/plain
+components/codetools/examples/scanexamples/publishedvars.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/resourcetest1.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/simpleunit1.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/test.h svneol=native#text/plain

components/codetools/codetoolmanager.pas

@@ -662,6 +662,8 @@ type
     function RenamePublishedVariable(Code: TCodeBuffer;
           const AClassName, OldVariableName, NewVarName,
           VarType: shortstring; ErrorOnClassNotFound: boolean): boolean;
+    function RetypeClassVariables(Code: TCodeBuffer; const AClassName: string;
+          ListOfReTypes: TStrings; ErrorOnClassNotFound: boolean): boolean;
     function FindDanglingComponentEvents(Code: TCodeBuffer;
           const AClassName: string;
           RootComponent: TComponent; ExceptionOnClassNotFound,
@@ -4606,6 +4608,23 @@ begin
   end;
 end;
 
+function TCodeToolManager.RetypeClassVariables(Code: TCodeBuffer;
+  const AClassName: string; ListOfReTypes: TStrings;
+  ErrorOnClassNotFound: boolean): boolean;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.RetypeClassVariables A ',Code.Filename,' ',AClassName);
+  {$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  try
+    Result:=FCurCodeTool.RetypeClassVariables(AClassName,ListOfReTypes,
+                                        ErrorOnClassNotFound,SourceChangeCache);
+  except
+    on e: Exception do Result:=HandleException(e);
+  end;
+end;
+
 function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer;
   const AClassName: string; RootComponent: TComponent;
   ExceptionOnClassNotFound, SearchInAncestors: boolean;

components/codetools/examples/retypepublishedvars.lpi

@@ -0,0 +1,59 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <Title Value="finddeclaration"/>
+    </General>
+    <VersionInfo>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion="0.0.0.0"/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="CodeTools"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="retypepublishedvars.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="retypepublishedvars"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="scanexamples/emptymethods1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="EmptyMethods1"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="README.txt"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="scanexamples/"/>
+    </SearchPaths>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

components/codetools/examples/retypepublishedvars.lpr

@@ -0,0 +1,80 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+  
+  Abstract:
+    Demonstrates how to change the types of the variables of a class.
+}
+program retypepublishedvars;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CodeCache, CodeToolManager, DefineTemplates,
+  CodeAtom, CodeToolsConfig, CodeToolsStructs, PascalParserTool;
+
+const
+  ConfigFilename = 'codetools.config';
+var
+  Code: TCodeBuffer;
+  Filename: String;
+  ListOfTypes: TStringList;
+begin
+  if (ParamCount>=1) and (Paramcount<>3) then begin
+    writeln('Usage:');
+    writeln('  ',ParamStr(0));
+    writeln('  ',ParamStr(0),' <filename.pas>');
+  end;
+
+  try
+    CodeToolBoss.SimpleInit(ConfigFilename);
+    
+    Filename:=ExpandFileName('scanexamples'+PathDelim+'publishedvars.pas');
+    
+    if (ParamCount>=3) then begin
+      Filename:=ExpandFileName(ParamStr(1));
+    end;
+
+    // Step 1: load the file
+    Code:=CodeToolBoss.LoadFile(Filename,false,false);
+    if Code=nil then
+      raise Exception.Create('loading failed '+Filename);
+
+    // complete code
+    ListOfTypes:=TStringList.Create;
+    ListOfTypes.Values['TExButton']:='TButton';
+    ListOfTypes.Values['TExEdit']:='TEdit';
+    if CodeToolBoss.RetypeClassVariables(Code,'TForm1',ListOfTypes,true)
+    then begin
+      writeln('Sucess:');
+      writeln('=========================');
+      writeln(Code.Source);
+      writeln('=========================');
+    end else begin
+      writeln('RetypeClassVariables failed: ',CodeToolBoss.ErrorMessage);
+    end;
+  except
+    on E: Exception do begin
+      writeln('EXCEPTION: '+E.Message);
+    end;
+  end;
+end.
+

components/codetools/examples/scanexamples/publishedvars.pas

@@ -0,0 +1,22 @@
+unit publishedvars; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  TForm1 = class(TForm)
+    Button1: TButton;
+    Button2: TExButton;
+    Button3: TExButton;
+    Edit1: TExEdit;
+  public
+  end;
+
+implementation
+
+end.
+

components/codetools/stdcodetools.pas

@@ -187,6 +187,9 @@ type
           ExceptionOnClassNotFound, WithVariables, WithMethods,
           WithProperties, WithAncestors: boolean;
           out TreeOfCodeTreeNodeExtension: TAVLTree): boolean;
+    function RetypeClassVariables(const AClassName: string;
+          ListOfTypes: TStrings; ExceptionOnClassNotFound: boolean;
+          SourceChangeCache: TSourceChangeCache): boolean;
     function FindDanglingComponentEvents(const TheClassName: string;
           RootComponent: TComponent; ExceptionOnClassNotFound,
           SearchInAncestors: boolean;
@@ -4901,6 +4904,80 @@ begin
   Result:=true;
 end;
 
+function TStandardCodeTool.RetypeClassVariables(const AClassName: string;
+  ListOfTypes: TStrings; ExceptionOnClassNotFound: boolean;
+  SourceChangeCache: TSourceChangeCache): boolean;
+var
+  ClassNode: TCodeTreeNode;
+  Node: TCodeTreeNode;
+  TypeNode: TCodeTreeNode;
+  i: Integer;
+  OldToNew: TStringToStringTree;
+  OldType: String;
+  NewType: string;
+  HasChanged: Boolean;
+begin
+
+  Result:=false;
+  BuildTree(true);
+  ClassNode:=FindClassNodeInInterface(AClassName,true,false,false);
+  if ClassNode=nil then begin
+    if ExceptionOnClassNotFound then
+      RaiseException(Format(ctsclassNotFound, ['"', AClassName, '"']))
+    else
+      exit;
+  end;
+  if (ListOfTypes=nil) or (ListOfTypes.Count=0) then exit(true);
+
+  OldToNew:=TStringToStringTree.Create(false);
+  try
+    for i:=0 to ListOfTypes.Count-1 do
+      OldToNew.Add(ListOfTypes.Names[i],ListOfTypes.ValueFromIndex[i]);
+
+    HasChanged:=false;
+    BuildSubTreeForClass(ClassNode);
+    Node:=ClassNode.FirstChild;
+    while (Node<>nil) and (Node.HasAsParent(ClassNode)) do begin
+      if (Node.Desc=ctnVarDefinition) and (Node.FirstChild<>nil) then begin
+        TypeNode:=Node.FirstChild;
+        if TypeNode.Desc=ctnIdentifier then begin
+          MoveCursorToNodeStart(TypeNode);
+          ReadNextAtom;
+          ReadNextAtom;
+          if CurPos.Flag=cafPoint then begin
+            // skip unitname
+            ReadNextAtom;
+          end else begin
+            UndoReadNextAtom;
+          end;
+          // cursor is now on identifier
+          OldType:=GetAtom;
+          if OldToNew.Contains(OldType) then begin
+            NewType:=OldToNew[OldType];
+            if OldType<>NewType then begin
+              // 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;
+        end;
+        Node:=Node.NextSkipChilds;
+      end else
+        Node:=Node.Next;
+    end;
+    if HasChanged then begin
+      if not SourceChangeCache.Apply then exit;
+    end;
+  finally
+    OldToNew.Free;
+  end;
+  Result:=true;
+end;
+
 function TStandardCodeTool.FindDanglingComponentEvents(
   const TheClassName: string; RootComponent: TComponent;
   ExceptionOnClassNotFound, SearchInAncestors: boolean;