diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas
index 8e4f8a7972..f1a574a6f4 100644
--- a/components/codetools/codetree.pas
+++ b/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
diff --git a/components/codetools/examples/codecompletion.lpi b/components/codetools/examples/codecompletion.lpi
index 76ed304720..1789b72229 100644
--- a/components/codetools/examples/codecompletion.lpi
+++ b/components/codetools/examples/codecompletion.lpi
@@ -10,25 +10,6 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/components/codetools/examples/codecompletion.lpr b/components/codetools/examples/codecompletion.lpr
index 83218d4bd0..e8b10bb0f2 100644
--- a/components/codetools/examples/codecompletion.lpr
+++ b/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
- Options:=TCodeToolsOptions.Create;
-
- // 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
- 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);
+ if (ParamCount>=1) and (Paramcount<>3) then begin
+ writeln('Usage:');
+ writeln(' ',ParamStr(0));
+ writeln(' ',ParamStr(0),' ');
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.
diff --git a/components/codetools/examples/scanexamples/completion1.pas b/components/codetools/examples/scanexamples/completion1.pas
index b8d108f435..7fefd3de11 100644
--- a/components/codetools/examples/scanexamples/completion1.pas
+++ b/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.
diff --git a/components/h2pas/h2pasconvert.pas b/components/h2pas/h2pasconvert.pas
index 937d6b31d0..980bba983f 100644
--- a/components/h2pas/h2pasconvert.pas
+++ b/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
- ExplicitTypes: TAvgLvlTree;// tree of TImplicitType
+ ImplicitTypes: TAVLTree;// 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*('
- +'PLongint\s*=\s*\^Longint'
- +'|PSmallInt\s*=\s*\^SmallInt'
- +'|PByte\s*=\s*\^Byte'
- +'|PWord\s*=\s*\^Word'
- +'|PDWord\s*=\s*\^DWord'
- +'|PDouble\s*=\s*\^Double'
- +'|PChar\s*=\s*\^Char'
- +');\s*$';
+ SearchFor:='';
+ for i:=Low(PreDefinedH2PasTypes) to High(PreDefinedH2PasTypes) do begin
+ if SearchFor<>'' then
+ SearchFor:=SearchFor+'|';
+ SearchFor:=SearchFor
+ +'P'+PreDefinedH2PasTypes[i]+'\s*=\s*\^'+PreDefinedH2PasTypes[i];
+ end;
+ SearchFor:='^\s*('+SearchFor+');\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 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 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.
diff --git a/components/h2pas/h2pasdlg.pas b/components/h2pas/h2pasdlg.pas
index 4aaf95db75..80529b0faf 100644
--- a/components/h2pas/h2pasdlg.pas
+++ b/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);
diff --git a/examples/scanline/unit1.lrs b/examples/scanline/unit1.lrs
index d4290da611..b24f4ae653 100644
--- a/examples/scanline/unit1.lrs
+++ b/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