h2pas wizard: added tool to add missing pointer types

git-svn-id: trunk@12336 -

components/codetools/codetree.pas

@@ -315,6 +315,8 @@ function FindCodeTreeNodeExt(Tree: TAVLTree; const Txt: string
 function FindCodeTreeNodeExtAVLNode(Tree: TAVLTree; const Txt: string): TAVLTreeNode;
 function CompareTxtWithCodeTreeNodeExt(p: Pointer;
                                        NodeData: pointer): integer;
+function CompareIdentifierWithCodeTreeNodeExt(p: Pointer;
+                                              NodeData: pointer): integer;
 function CompareCodeTreeNodeExt(NodeData1, NodeData2: pointer): integer;
 function CompareCodeTreeNodeExtWithPos(NodeData1, NodeData2: pointer): integer;
 function CompareCodeTreeNodeExtWithNodeStartPos(
@@ -459,6 +461,15 @@ begin
   //debugln('CompareTxtWithCodeTreeNodeExt ',NodeExt.Txt,' ',s,' ',dbgs(Result));
 end;
 
+function CompareIdentifierWithCodeTreeNodeExt(p: Pointer; NodeData: pointer
+  ): integer;
+var
+  NodeExt: TCodeTreeNodeExtension;
+begin
+  NodeExt:=TCodeTreeNodeExtension(NodeData);
+  Result:=CompareIdentifierPtrs(p,Pointer(NodeExt.Txt));
+end;
+
 function CompareCodeTreeNodeExt(NodeData1, NodeData2: pointer): integer;
 var NodeExt1, NodeExt2: TCodeTreeNodeExtension;
 begin

components/codetools/examples/codecompletion.lpi

@@ -10,25 +10,6 @@
       <TargetFileExt Value=""/>
       <Title Value="finddeclaration"/>
     </General>
-    <VersionInfo>
-      <UseVersionInfo Value="False"/>
-      <AutoIncrementBuild Value="False"/>
-      <CurrentVersionNr Value="0"/>
-      <CurrentMajorRevNr Value="0"/>
-      <CurrentMinorRevNr Value="0"/>
-      <CurrentBuildNr Value="0"/>
-      <ProjectVersion Value="1.0.0.0"/>
-      <Language Value="0409"/>
-      <CharSet Value="04E4"/>
-      <Comments Value=""/>
-      <CompanyName Value=""/>
-      <FileDescription Value=""/>
-      <InternalName Value=""/>
-      <LegalCopyright Value=""/>
-      <LegalTrademarks Value=""/>
-      <OriginalFilename Value=""/>
-      <ProductName Value=""/>
-    </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>

components/codetools/examples/codecompletion.lpr

@@ -39,48 +39,91 @@ var
   NewCode: TCodeBuffer;
   NewX, NewY, NewTopLine: integer;
   Code: TCodeBuffer;
+  X: Integer;
+  Y: Integer;
+  TopLine: Integer;
 begin
-  // setup the Options
+  if (ParamCount>=1) and (Paramcount<>3) then begin
-  Options:=TCodeToolsOptions.Create;
+    writeln('Usage:');
-
+    writeln('  ',ParamStr(0));
-  // To not parse the FPC sources every time, the options are saved to a file.
+    writeln('  ',ParamStr(0),' <filename> <X> <Y>');
-  if FileExists(ConfigFilename) then
-    Options.LoadFromFile(ConfigFilename);
-
-  // setup your paths
-  Options.FPCPath:='/usr/bin/ppc386';
-  Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
-  Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
-  
-  // optional: ProjectDir and TestPascalFile exists only to easily test some
-  // things.
-  Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
-  Options.TestPascalFile:=Options.ProjectDir+'completion1.pas';
-
-  // init the codetools
-  if not Options.UnitLinkListValid then
-    writeln('Scanning FPC sources may take a while ...');
-  CodeToolBoss.Init(Options);
-
-  // save the options and the FPC unit links results.
-  Options.SaveToFile(ConfigFilename);
-  
-  // Example: find declaration of 'TObject'
-  
-  // Step 1: load the file
-  Code:=CodeToolBoss.LoadFile(Options.TestPascalFile,false,false);
-  if Code=nil then
-    raise Exception.Create('loading failed '+Options.TestPascalFile);
-
-  // Step 2: find declaration
-  if CodeToolBoss.CompleteCode(Code,3,36,20,NewCode,NewX,NewY,NewTopLine) then
-  begin
-    writeln('Code completed: ',NewCode.Filename,' Line=',NewY,' Column=',NewX);
-    writeln(Code.Source);
-  end else begin
-    writeln('Code completion failed: ',CodeToolBoss.ErrorMessage);
   end;
 
+  // setup the Options
+  Options:=TCodeToolsOptions.Create;
+  try
+    // To not parse the FPC sources every time, the options are saved to a file.
+    if FileExists(ConfigFilename) then
+      Options.LoadFromFile(ConfigFilename);
+
+    // setup your paths
+    writeln('Config=',ConfigFilename);
+    if FileExists(ConfigFilename) then begin
+      Options.LoadFromFile(ConfigFilename);
+    end else begin
+      Options.InitWithEnvironmentVariables;
+      if Options.FPCPath='' then
+        Options.FPCPath:='/usr/bin/ppc386';
+      if Options.FPCSrcDir='' then
+        Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
+      if Options.LazarusSrcDir='' then
+        Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
+      { Linux }
+      {Options.FPCPath:='/usr/bin/ppc386';
+      Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
+      Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');}
+
+      { Windows
+      Options.FPCPath:='C:\lazarus\fpc\2.2.0\bin\i386-win32\ppc386.exe';
+      Options.FPCSrcDir:='C:\lazarus\fpc\2.2.0\source';
+      Options.LazarusSrcDir:='C:\lazarus\';}
+    end;
+
+    // optional: ProjectDir and TestPascalFile exists only to easily test some
+    //           things.
+    Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
+    Options.TestPascalFile:=Options.ProjectDir+'completion1.pas';
+
+    // init the codetools
+    if not Options.UnitLinkListValid then
+      writeln('Scanning FPC sources may take a while ...');
+    CodeToolBoss.Init(Options);
+
+    // save the options and the FPC unit links results.
+    Options.SaveToFile(ConfigFilename);
+
+    // Example: complete identifier s,
+    //          by adding a local variable declaration (var s: string)
+    X:=3;
+    Y:=41;
+    TopLine:=20;
+
+    writeln('FPCSrcDir=',Options.FPCSrcDir);
+    writeln('FPC=',Options.FPCPath);
+    if (ParamCount>=3) then begin
+      Options.TestPascalFile:=ExpandFileName(ParamStr(1));
+      X:=StrToInt(ParamStr(2));
+      Y:=StrToInt(ParamStr(3));
+    end;
+
+    // Step 1: load the file
+    Code:=CodeToolBoss.LoadFile(Options.TestPascalFile,false,false);
+    if Code=nil then
+      raise Exception.Create('loading failed '+Options.TestPascalFile);
+
+    // complete code
+    if CodeToolBoss.CompleteCode(Code,X,Y,TopLine,NewCode,NewX,NewY,NewTopLine)
+    then begin
+      writeln('Code completed: ',NewCode.Filename,' Line=',NewY,' Column=',NewX);
+      writeln(Code.Source);
+    end else begin
+      writeln('Code completion failed: ',CodeToolBoss.ErrorMessage);
+    end;
+  except
+    on E: Exception do begin
+      writeln(E.Message);
+    end;
+  end;
   Options.Free;
 end.
 

components/codetools/examples/scanexamples/completion1.pas

@@ -19,6 +19,8 @@
  ***************************************************************************
 
   Author: Mattias Gaertner
+  
+  This is an example unit to demonstrate some features of the code completion.
 }
 unit Completion1;
 
@@ -33,7 +35,15 @@ implementation
 
 procedure DoSomething;
 begin
-  s:='Path'+PathDelim;
+  // put the cursor at the beginning of this comment and code completion will
+  // add DoSomething to the interface
+  
+  Str:='Path'+PathDelim; // put the cursor on 'Str' and code completion will
+            // insert a local variable var Str: String in front of the 'begin'
+
+  // Not yet implemented:
+  //NewProcedure(12345); // put the cursor on 'NewProcedure' and code completion
+            // will create a new procedure
 end;
 
 end.

components/h2pas/h2pasconvert.pas

@@ -24,9 +24,10 @@ interface
 
 uses
   Classes, SysUtils, LCLProc, LResources, LazConfigStorage, XMLPropStorage,
-  Forms, Controls, Dialogs, FileUtil, FileProcs, AvgLvlTree,
+  Forms, Controls, Dialogs, FileUtil, FileProcs, AVL_Tree,
   // CodeTools
-  KeywordFuncLists, BasicCodeTools, CodeCache, CodeToolManager,
+  CodeAtom, CodeTree, KeywordFuncLists, BasicCodeTools, CodeCache,
+  SourceChanger, CodeToolManager,
   // IDEIntf
   TextTools, IDEExternToolIntf, IDEDialogs, LazIDEIntf, SrcEditorIntf,
   IDEMsgIntf, IDETextConverter;
@@ -153,8 +154,8 @@ type
   TReplaceImplicitTypes = class(TCustomTextConverterTool)
   private
     Src: String;
-    ImplicitTypes: TAvgLvlTree;// tree of TImplicitType
+    ImplicitTypes: TAVLTree;// tree of TImplicitType
-    ExplicitTypes: TAvgLvlTree;// tree of TImplicitType
+    ExplicitTypes: TAVLTree;// tree of TImplicitType
     TypeStart: LongInt;
     TypeEnd: integer; // 0 means invalid
     ConstSectionStart: LongInt;
@@ -203,6 +204,16 @@ type
   end;
   
 
+  { TAddMissingPointerTypes
+    Add missing pointer types like PPPChar }
+
+  TAddMissingPointerTypes = class(TCustomTextConverterTool)
+  public
+    class function ClassDescription: string; override;
+    function Execute(aText: TIDETextConverter): TModalResult; override;
+  end;
+
+
   { TFixAliasDefinitionsInUnit - fix section type of alias definitions
 
     Checks all alias definitions of the form
@@ -216,6 +227,7 @@ type
     function Execute(aText: TIDETextConverter): TModalResult; override;
   end;
   
+  
   { TFixH2PasMissingIFDEFsInUnit - add missing IFDEFs for function bodies }
 
   TFixH2PasMissingIFDEFsInUnit = class(TCustomTextConverterTool)
@@ -223,6 +235,7 @@ type
     class function ClassDescription: string; override;
     function Execute(aText: TIDETextConverter): TModalResult; override;
   end;
+  
 
   { TReduceCompilerDirectivesInUnit - removes unneeded directives }
 
@@ -242,6 +255,7 @@ type
     property Defines: TStrings read FDefines write SetDefines;
   end;
 
+
   { TReplaceConstFunctionsInUnit - replace simple assignment functions with constants }
 
   TReplaceConstFunctionsInUnit = class(TCustomTextConverterTool)
@@ -308,6 +322,7 @@ type
     phRemoveEmptyTypeVarConstSections, // Remove empty type/var/const sections
     phReplaceImplicitTypes, // Search implicit types in parameters and add types for them
     phFixArrayOfParameterType, // Replace "array of )" with "array of const)"
+    phAddMissingPointerTypes, // add missing pointer types
     phRemoveRedefinitionsInUnit, // Removes redefinitions of types, variables, constants and resourcestrings
     phFixAliasDefinitionsInUnit, // fix section type of alias definitions
     phReplaceConstFunctionsInUnit, // replace simple assignment functions with constants
@@ -608,6 +623,20 @@ type
     property Executing: boolean read FExecuting;
     property LastUsedFilename: string read FLastUsedFilename;
   end;
+  
+const
+  PreDefinedH2PasTypes: array[1..10] of string = (
+    'Char',
+    'Byte',
+    'SmallInt',
+    'Word',
+    'Longint',
+    'DWord',
+    'Int64',
+    'QWord',
+    'Single',
+    'Double'
+    );
 
 implementation
 
@@ -2137,7 +2166,7 @@ end;
 function TRemoveEmptyCMacrosTool.Execute(aText: TIDETextConverter
   ): TModalResult;
 var
-  EmptyMacros: TAvgLvlTree;// tree of PChar
+  EmptyMacros: TAVLTree;// tree of PChar
 
   procedure AddEmptyMacro(const MacroName: string);
   var
@@ -2146,7 +2175,7 @@ var
   begin
     //DebugLn(['AddEmptyMacro MacroName="',MacroName,'"']);
     if EmptyMacros=nil then
-      EmptyMacros:=TAvgLvlTree.Create(TListSortCompare(@CompareIdentifiers));
+      EmptyMacros:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
     Identifier:=@MacroName[1];
     if EmptyMacros.Find(Identifier)<>nil then exit;
     TempStr:=MacroName; // increase refcount
@@ -2159,7 +2188,7 @@ var
   var
     OldMacroName: String;
     Identifier: PChar;
-    Node: TAvgLvlTreeNode;
+    Node: TAVLTreeNode;
   begin
     //DebugLn(['DeleteEmptyMacro MacroName="',MacroName,'"']);
     if EmptyMacros=nil then exit;
@@ -2175,7 +2204,7 @@ var
   procedure FreeMacros;
   var
     CurMacroName: String;
-    Node: TAvgLvlTreeNode;
+    Node: TAVLTreeNode;
   begin
     if EmptyMacros=nil then exit;
     CurMacroName:='';
@@ -2338,6 +2367,7 @@ var
   Flags: TSrcEditSearchOptions;
   Prompt: Boolean;
   SearchFor: string;
+  i: Integer;
 begin
   Result:=mrCancel;
   if aText=nil then exit;
@@ -2345,15 +2375,14 @@ begin
   
   Flags:=[sesoReplace,sesoReplaceAll,sesoRegExpr];
   Prompt:=false;
-  SearchFor:='^\s*('
+  SearchFor:='';
-     +'PLongint\s*=\s*\^Longint'
+  for i:=Low(PreDefinedH2PasTypes) to High(PreDefinedH2PasTypes) do begin
-    +'|PSmallInt\s*=\s*\^SmallInt'
+    if SearchFor<>'' then
-    +'|PByte\s*=\s*\^Byte'
+      SearchFor:=SearchFor+'|';
-    +'|PWord\s*=\s*\^Word'
+    SearchFor:=SearchFor
-    +'|PDWord\s*=\s*\^DWord'
+               +'P'+PreDefinedH2PasTypes[i]+'\s*=\s*\^'+PreDefinedH2PasTypes[i];
-    +'|PDouble\s*=\s*\^Double'
+  end;
-    +'|PChar\s*=\s*\^Char'
+  SearchFor:='^\s*('+SearchFor+');\s*$';
-    +');\s*$';
   Result:=IDESearchInText('',Source,SearchFor,'',Flags,Prompt,nil);
   if Result<>mrOk then exit;
   
@@ -2591,7 +2620,7 @@ begin
     NewType.Code:=TypeCode;
     NewType.MaxPosition:=StartPos;
     if ImplicitTypes=nil then
-      ImplicitTypes:=TAvgLvlTree.Create(@CompareImplicitTypeNames);
+      ImplicitTypes:=TAVLTree.Create(@CompareImplicitTypeNames);
     ImplicitTypes.Add(NewType);
   end;
   ModalResult:=mrOk;
@@ -2608,7 +2637,7 @@ end;
 
 procedure TReplaceImplicitTypes.AdjustMinPositions(const Identifier: string);
 var
-  Node: TAvgLvlTreeNode;
+  Node: TAVLTreeNode;
   Item: TImplicitType;
   Position: Integer;
   AtomStart: LongInt;
@@ -3013,7 +3042,7 @@ function TReplaceImplicitTypes.InsertNewTypes(var ModalResult: TModalResult
   end;
 
 var
-  Node: TAvgLvlTreeNode;
+  Node: TAVLTreeNode;
   Item: TImplicitType;
   InsertPos: integer;
   NextItem: TImplicitType;
@@ -3110,7 +3139,7 @@ var
   EndPos: Integer;
   TypeCode: String;
   TypeName: String;
-  Node: TAvgLvlTreeNode;
+  Node: TAVLTreeNode;
   Item: TImplicitType;
 begin
   Result:=false;
@@ -3322,11 +3351,11 @@ function TFixAliasDefinitionsInUnit.Execute(aText: TIDETextConverter
   ): TModalResult;
 begin
   Result:=mrCancel;
+  if aText=nil then exit;
   if (not FilenameIsPascalUnit(aText.Filename)) then begin
     DebugLn(['TFixAliasDefinitionsInUnit.Execute file is not pascal: ',aText.Filename]);
     exit(mrOk);// ignore
   end;
-  // finish codetools FixAllAliasDefinitions
   if not CodeToolBoss.FixAllAliasDefinitions(TCodeBuffer(aText.CodeBuffer)) then begin
     DebugLn(['TFixAliasDefinitionsInUnit.Execute FixAllAliasDefinitions failed ',CodeToolBoss.ErrorMessage]);
     exit;
@@ -3687,17 +3716,19 @@ begin
              TFixH2PasMissingIFDEFsInUnit,Result) then exit;
   // reduce compiler directives so that other tools can work with less double data
   if not ReduceCompilerDirectives(Changed,Result) then exit;
-  // remove h2pas redefinitions, so data get unambiguous types
+  // remove h2pas redefinitions to data get unambiguous types
   if not Run(phRemoveRedefinedPointerTypes,
              TRemoveRedefinedPointerTypes,Result) then exit;
   if not Run(phRemoveEmptyTypeVarConstSections,
              TRemoveEmptyTypeVarConstSections,Result) then exit;
-  // replace implicit types, not converted by h2pas
+  // add / replace implicit types, not converted by h2pas
   if not Run(phReplaceImplicitTypes,
              TReplaceImplicitTypes,Result) then exit;
   if not Run(phFixArrayOfParameterType,
              TFixArrayOfParameterType,Result) then exit;
-  // remove redefinitions, so data get unambiguous types
+  if not Run(phAddMissingPointerTypes,
+             TAddMissingPointerTypes,Result) then exit;
+  // remove redefinitions, to data get unambiguous types
   if not Run(phRemoveRedefinitionsInUnit,
              TRemoveRedefinitionsInUnit,Result) then exit;
 
@@ -3741,7 +3772,7 @@ function TConvertFunctionTypesToPointers.Execute(aText: TIDETextConverter
 var
   Src: String;
   SrcLen: Integer;
-  FuncTypes: TAvgLvlTree; // tree of TImplicitType
+  FuncTypes: TAVLTree; // tree of TImplicitType
 
   procedure CheckTypeDef(var p: integer);
   // Check if it is:  typedef identifier ( funcname ) (
@@ -3786,7 +3817,7 @@ var
     NewType.Name:=copy(Src,StartPos,EndPos-StartPos);
     writeln('TConvertFunctionTypesToPointers.Execute.CheckType function type found  Name=',NewType.Name);
     if FuncTypes=nil then
-      FuncTypes:=TAvgLvlTree.Create(@CompareImplicitTypeNames);
+      FuncTypes:=TAVLTree.Create(@CompareImplicitTypeNames);
     FuncTypes.Add(NewType);
     // add * in front of name
     System.Insert('*',Src,StartPos);
@@ -3946,4 +3977,240 @@ begin
   Result:=mrOk;
 end;
 
+{ TAddMissingPointerTypes }
+
+class function TAddMissingPointerTypes.ClassDescription: string;
+begin
+  Result:='Add missing pointer types like PPPChar';
+end;
+
+function TAddMissingPointerTypes.Execute(aText: TIDETextConverter
+  ): TModalResult;
+{ h2pas converts implicit pointer types like 'Identifier ***' to PPPIdentifier,
+  but it only adds PIdentifier = ^Identifier.
+  This tool adds the missing
+    PPIdentifier = ^PIdentifier;
+    PPPIdentifier = ^PPIdentifier;
+}
+var
+  Tool: TCodeTool;
+  Definitions: TAVLTree;// tree of TCodeTreeNodeExtension
+  NeededPointerTypes: TAVLTree; // tree of TImplicitType
+  DefaultTypeSectionPos: integer;
+  
+  function IdentifierIsDefined(Identifier: PChar): boolean;
+  var
+    i: Integer;
+  begin
+    if WordIsKeyWord.DoIt(Identifier) then exit(true);
+    if WordIsPredefinedFPCIdentifier.DoIt(Identifier) then exit(true);
+    if (Definitions<>nil)
+    and (Definitions.FindKey(Identifier,@CompareIdentifierWithCodeTreeNodeExt)<>nil)
+    then exit(true);
+    for i:=Low(PreDefinedH2PasTypes) to High(PreDefinedH2PasTypes) do begin
+      if CompareIdentifierPtrs(Identifier,Pointer(PreDefinedH2PasTypes[i]))=0 then
+        exit(true);
+      // check for predefined pointer types
+      if (Identifier^ in ['p','P'])
+      and (IsIdentChar[Identifier[1]])
+      and (CompareIdentifierPtrs(@Identifier[1],Pointer(PreDefinedH2PasTypes[i]))=0)
+      then
+        exit(true);
+    end;
+    //DebugLn(['IdentifierIsDefined not found: ',GetIdentifier(Identifier)]);
+    Result:=false;
+  end;
+  
+  procedure AddNeededPointerType(Position, Count: integer);
+  var
+    Item: TImplicitType;
+    Identifier: PChar;
+    AVLNode: TAVLTreeNode;
+  begin
+    if NeededPointerTypes=nil then
+      NeededPointerTypes:=TAVLTree.Create(@CompareImplicitTypeNames);
+    Identifier:=@Tool.Src[Position+Count];
+    AVLNode:=NeededPointerTypes.FindKey(Identifier,
+                                        @CompareImplicitTypeStringAndName);
+    //DebugLn(['AddNeededPointerType ',GetIdentifier(Identifier),' Position=',Position,' Count=',Count]);
+    if AVLNode<>nil then begin
+      Item:=TImplicitType(AVLNode.Data);
+      if Item.MaxPosition<Count then
+        Item.MaxPosition:=Count;
+    end else begin
+      Item:=TImplicitType.Create;
+      Item.Name:=GetIdentifier(Identifier);
+      Item.MinPosition:=Position;
+      Item.MaxPosition:=Count;
+      NeededPointerTypes.Add(Item);
+    end;
+  end;
+  
+  procedure CheckIdentifier(Position: integer);
+  var
+    Identifier: PChar;
+    Level: Integer;
+  begin
+    Identifier:=@Tool.Src[Position];
+    Level:=0;
+    while (Identifier[Level] in ['p','P']) do begin
+      // this identifier starts with a P, so it can be a pointer type
+      if IdentifierIsDefined(@Tool.Src[Position+Level]) then break;
+      inc(Level);
+    end;
+    //DebugLn(['CheckIdentifier ',GetIdentifier(Identifier),' Level=',Level]);
+    if Level=0 then begin
+      // the identifier is defined
+      exit;
+    end;
+    if (not (Identifier[Level] in ['p','P']))
+    and (IsIdentChar[Identifier[Level]])
+    and not (IdentifierIsDefined(@Tool.Src[Position+Level])) then begin
+      // the base type is not defined
+      // => this is not a pointer type
+    end;
+    AddNeededPointerType(Position,Level);
+  end;
+  
+  function AddNeededPointerTypesToSource(Item: TImplicitType): boolean;
+  var
+    AVLNode: TAVLTreeNode;
+    NodeExt: TCodeTreeNodeExtension;
+    Node: TCodeTreeNode;
+    i: Integer;
+    NewTxt: String;
+    InsertPos: LongInt;
+    Indent: LongInt;
+    Identifier: String;
+  begin
+    Result:=false;
+    
+    CodeToolBoss.SourceChangeCache.MainScanner:=Tool.Scanner;
+    
+    // find definition
+    InsertPos:=0;
+    if (Definitions<>nil) then begin
+      AVLNode:=Definitions.FindKey(Pointer(Item.Name),
+                                   @CompareIdentifierWithCodeTreeNodeExt);
+      if AVLNode<>nil then begin
+        NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
+        Node:=NodeExt.Node;
+        InsertPos:=Tool.FindLineEndOrCodeAfterPosition(Node.EndPos);
+        Indent:=GetLineIndent(Tool.Src,Node.StartPos);
+      end;
+    end;
+    if (InsertPos<1) then begin
+      if DefaultTypeSectionPos<1 then begin
+        // start a type section at the beginning
+        Node:=Tool.FindMainUsesSection(false);
+        if Node<>nil then begin
+          if Node.NextBrother<>nil then
+            Node:=Node.NextBrother;
+        end else begin
+          Node:=Tool.FindInterfaceNode;
+          if Node<>nil then begin
+            if Node.FirstChild<>nil then
+              Node:=Node.FirstChild;
+          end;
+        end;
+        if Node<>nil then begin
+          if Node.Desc=ctnUsesSection then begin
+            // insert behind node
+            DefaultTypeSectionPos:=
+                    Tool.FindLineEndOrCodeAfterPosition(Node.EndPos);
+          end else if Node.Desc=ctnInterface then begin
+            // insert at end of node
+            DefaultTypeSectionPos:=Node.EndPos;
+          end else begin
+            // insert in front of node
+            DefaultTypeSectionPos:=
+                    Tool.FindLineEndOrCodeInFrontOfPosition(Node.StartPos,true);
+          end;
+        end else begin
+          DefaultTypeSectionPos:=1;
+        end;
+        DebugLn(['AddNeededPointerTypesToSource start type section']);
+        if not CodeToolBoss.SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
+          DefaultTypeSectionPos,DefaultTypeSectionPos,'type') then exit;
+      end;
+      InsertPos:=DefaultTypeSectionPos;
+      Indent:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.Indent;
+    end;
+    
+    // add pointer types
+    Identifier:=Item.Name;
+    NewTxt:='';
+    for i:=Item.MaxPosition downto 1 do begin
+      if NewTxt<>'' then
+        NewTxt:=NewTxt+CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.LineEnd;
+      NewTxt:=NewTxt+GetIndentStr(Indent)+'P'+Identifier+'=^'+Identifier+';';
+      Identifier:='P'+Identifier;
+    end;
+    DebugLn(['AddNeededPointerTypesToSource Add pointer types: "',NewTxt,'"']);
+    Result:=CodeToolBoss.SourceChangeCache.Replace(gtNewLine,gtNewLine,
+      InsertPos,InsertPos,NewTxt);
+  end;
+
+  function AddNeededPointerTypesToSource: boolean;
+  var
+    AVLNode: TAVLTreeNode;
+    Item: TImplicitType;
+  begin
+    Result:=true;
+    if NeededPointerTypes<>nil then begin
+      AVLNode:=NeededPointerTypes.FindLowest;
+      while AVLNode<>nil do begin
+        Item:=TImplicitType(AVLNode.Data);
+        if not AddNeededPointerTypesToSource(Item) then exit;
+        AVLNode:=NeededPointerTypes.FindSuccessor(AVLNode);
+      end;
+      Result:=CodeToolBoss.SourceChangeCache.Apply;
+    end;
+  end;
+  
+begin
+  Result:=mrCancel;
+  if aText=nil then exit;
+  if (not FilenameIsPascalUnit(aText.Filename)) then begin
+    DebugLn(['TAddMissingPointerTypes.Execute file is not pascal: ',aText.Filename]);
+    exit(mrOk);// ignore
+  end;
+  if not CodeToolBoss.Explore(TCodeBuffer(aText.CodeBuffer),Tool,true,false)
+  then begin
+    DebugLn(['TAddMissingPointerTypes.Execute Explore failed ',CodeToolBoss.ErrorMessage]);
+    exit;
+  end;
+  DebugLn(['TAddMissingPointerTypes.Execute ']);
+  Definitions:=nil;
+  NeededPointerTypes:=nil;
+  DefaultTypeSectionPos:=0;
+  try
+    // collect definitions
+    if not Tool.GatherUnitDefinitions(Definitions,true,false) then begin
+      DebugLn(['TAddMissingPointerTypes.Execute GatherUnitDefinitions failed ',CodeToolBoss.ErrorMessage]);
+      exit;
+    end;
+    // check all used identifiers
+    Tool.MoveCursorToCleanPos(1);
+    while Tool.CurPos.StartPos<Tool.SrcLen do begin
+      Tool.ReadNextAtom;
+      if Tool.CurPos.StartPos>=Tool.SrcLen then break;
+      if (Tool.CurPos.Flag=cafWord) then
+        CheckIdentifier(Tool.CurPos.StartPos);
+    end;
+    // add all needed pointer types
+    if not AddNeededPointerTypesToSource then exit;
+  finally
+    if Definitions<>nil then begin
+      NodeExtMemManager.DisposeAVLTree(Definitions);
+      Definitions:=nil;
+    end;
+    if NeededPointerTypes<>nil then begin
+      NeededPointerTypes.FreeAndClear;
+      NeededPointerTypes.Free;
+    end;
+  end;
+  Result:=mrOk;
+end;
+
 end.

components/h2pas/h2pasdlg.pas

@@ -225,6 +225,7 @@ begin
   TextConverterToolClasses.RegisterClass(TReduceCompilerDirectivesInUnit);
   TextConverterToolClasses.RegisterClass(TReplaceImplicitTypes);
   TextConverterToolClasses.RegisterClass(TFixArrayOfParameterType);
+  TextConverterToolClasses.RegisterClass(TAddMissingPointerTypes);
   TextConverterToolClasses.RegisterClass(TRemoveRedefinitionsInUnit);
   TextConverterToolClasses.RegisterClass(TFixAliasDefinitionsInUnit);
   TextConverterToolClasses.RegisterClass(TReplaceConstFunctionsInUnit);

examples/scanline/unit1.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TForm1','FORMDATA',[
   'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3#144#0#3'Top'#3#189#0#5'W'
   +'idth'#3'o'#2#18'HorzScrollBar.Page'#3'n'#2#18'VertScrollBar.Page'#3#143#0#7