paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 21:18:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

h2pas wizard: added tool to add missing pointer types

Browse Source 
git-svn-id: trunk@12336 -
This commit is contained in:
mattias 2007-10-05 20:43:40 +00:00
parent 3d5706e971
commit 9f67277474
7 changed files with 399 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/codetools/codetree.pas
View File

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

19
components/codetools/examples/codecompletion.lpi
View File

@ -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)"/>

121
components/codetools/examples/codecompletion.lpr
View File

@ -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),' <filename> <X> <Y>');
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.

12
components/codetools/examples/scanexamples/completion1.pas
View File

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

321
components/h2pas/h2pasconvert.pas
View File

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

1
components/h2pas/h2pasdlg.pas
View File

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

2
examples/scanline/unit1.lrs
View File

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