From 9f672774749f362b1cdaaae09da24c1b283a63f6 Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 5 Oct 2007 20:43:40 +0000 Subject: [PATCH] h2pas wizard: added tool to add missing pointer types git-svn-id: trunk@12336 - --- components/codetools/codetree.pas | 11 + .../codetools/examples/codecompletion.lpi | 19 -- .../codetools/examples/codecompletion.lpr | 121 ++++--- .../examples/scanexamples/completion1.pas | 12 +- components/h2pas/h2pasconvert.pas | 321 ++++++++++++++++-- components/h2pas/h2pasdlg.pas | 1 + examples/scanline/unit1.lrs | 2 - 7 files changed, 399 insertions(+), 88 deletions(-) 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 @@ </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)"/> 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),' <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. 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<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. 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