1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     TCodeCompletionCodeTool enhances TMethodJumpingCodeTool.
25 
26     Code Completion is
27       - complete properties
28           - complete property statements
29           - add private variables and private access methods
30       - add missing method bodies
31           - add useful statements
32       - add missing forward proc bodies
33       - add missing semicolons at end of procedures
34       - complete event assignments
35       - complete local variables
36       - complete local variables as parameter
37       - insert header comment for classes
38 
39   ToDo:
40     -add code for array properties (TList, TFPList, array of, Pointer array)
41       TList:
42         property Items[Index: integer]: AType;
43         -> creates via dialog
44           property Items[Index: integer]: Type2 read GetItems write SetItems;
45           private FItems: TList;
46           private function GetItems(Index: integer): Type2;
47             begin
48               Result:=Type2(FItems[Index]);
49             end;
50           private procedure SetItems(Index: integer; const AValue: Type2);
51             begin
52               FItems[Index]:=Type2;
53             end;
54           public constructor Create;
55             begin
56               FItems:=TList.Create;
57             end;
58           public destructor Destroy; override;
59             begin
60               FItems.Free;
61               inherited Destroy;
62             end;
63 }
64 unit CodeCompletionTool;
65 
66 {$ifdef FPC}{$mode objfpc}{$endif}{$H+}
67 
68 interface
69 
70 {$I codetools.inc}
71 
72 {off $DEFINE CTDEBUG}
73 {$DEFINE VerboseCompletionAdds}
74 {off $DEFINE VerboseUpdateProcBodySignatures}
75 {off $DEFINE VerboseCompleteMethod}
76 {off $DEFINE VerboseCreateMissingClassProcBodies}
77 {off $DEFINE VerboseCompleteLocalVarAssign}
78 {off $DEFINE VerboseCompleteEventAssign}
79 {off $DEFINE EnableCodeCompleteTemplates}
80 {$DEFINE VerboseGetPossibleInitsForVariable}
81 {off $DEFINE VerboseGuessTypeOfIdentifier}
82 
83 uses
84   {$IFDEF MEM_CHECK}
85   MemCheck,
86   {$ENDIF}
87   // RTL + FCL
88   Classes, SysUtils, contnrs, Laz_AVL_Tree,
89   // CodeTools
90   FileProcs, CodeToolsStrConsts, StdCodeTools,
91   CodeTree, CodeAtom, CodeCache, CustomCodeTool, PascalParserTool, MethodJumpTool,
92   FindDeclarationTool, KeywordFuncLists, CodeToolsStructs, BasicCodeTools,
93   LinkScanner, SourceChanger, CodeGraph, PascalReaderTool,
94   {$IFDEF EnableCodeCompleteTemplates}
95   CodeCompletionTemplater,
96   {$ENDIF}
97   // LazUtils
98   LazFileUtils, LazDbgLog, AvgLvlTree;
99 
100 type
101   TNewClassPart = (ncpPrivateProcs, ncpPrivateVars,
102                    ncpProtectedProcs, ncpProtectedVars,
103                    ncpPublicProcs, ncpPublicVars,
104                    ncpPublishedProcs, ncpPublishedVars);
105 
106   TNewVarLocation = (
107     ncpvPrivate,ncpvProtected,ncpvPublic,ncpvPublished,ncpvLocal
108     );
109 
110 const
111   NewClassPartProcs = [ncpPrivateProcs,ncpProtectedProcs,ncpPublicProcs,ncpPublishedProcs];
112   NewClassPartVars = [ncpPrivateVars,ncpProtectedVars,ncpPublicVars,ncpPublishedVars];
113 
114   NewClassPartVisibility: array[TNewClassPart] of TPascalClassSection = (
115     pcsPrivate, pcsPrivate,
116     pcsProtected, pcsProtected,
117     pcsPublic, pcsPublic,
118     pcsPublished, pcsPublished
119     );
120 
121   PascalClassSectionToNodeDesc: array[TPascalClassSection] of TCodeTreeNodeDesc = (
122     ctnClassPrivate,   // pcsPrivate
123     ctnClassProtected, // pcsProtected
124     ctnClassPublic,    // pcsPublic
125     ctnClassPublished  // pcsPublished
126   );
127 
128   InsertClassSectionToNewProcClassPart: array[TInsertClassSection] of TNewClassPart = (
129     ncpPrivateProcs,
130     ncpProtectedProcs,
131     ncpPublicProcs,
132     ncpPublishedProcs
133   );
134   InsertClassSectionToNewVarClassPart: array[TInsertClassSection] of TNewClassPart = (
135     ncpPrivateVars,
136     ncpProtectedVars,
137     ncpPublicVars,
138     ncpPublishedVars
139   );
140 
141 type
142   TCodeCreationDlgResult = record
143     Location: TCreateCodeLocation;
144     ClassSection: TInsertClassSection;
145   end;
146 
147   { TCodeCompletionCodeTool }
148 
149   TCodeCompletionCodeTool = class(TMethodJumpingCodeTool)
150   private
151     FCompletingCursorNode: TCodeTreeNode;
152     FSourceChangeCache: TSourceChangeCache;
153     FCodeCompleteClassNode: TCodeTreeNode; // the class that is to be completed (ctnClass, ...)
154     FCompletingFirstEntryNode: TCodeTreeNode; // the first variable/method/GUID node in FCodeCompleteClassNode
155     FAddInheritedCodeToOverrideMethod: boolean;
156     FCompleteProperties: boolean;
157     FirstInsert: TCodeTreeNodeExtension; // list of insert requests
158     FSetPropertyVariablename: string;
159     FSetPropertyVariableIsPrefix: Boolean;
160     FSetPropertyVariableUseConst: Boolean;
161     FJumpToProcHead: TPascalMethodHeader;
162     NewClassSectionIndent: array[TPascalClassSection] of integer;
163     NewClassSectionInsertPos: array[TPascalClassSection] of integer;
164     fFullTopLvlName: string;// used by OnTopLvlIdentifierFound
165     fNewMainUsesSectionUnits: TAVLTree; // tree of AnsiString
166     procedure AddNewPropertyAccessMethodsToClassProcs(ClassProcs: TAVLTree;
167       const TheClassName: string);
168     procedure SetSetPropertyVariableIsPrefix(aValue: Boolean);
169     procedure SetSetPropertyVariablename(AValue: string);
170     procedure SetSetPropertyVariableUseConst(aValue: Boolean);
UpdateProcBodySignaturenull171     function UpdateProcBodySignature(ProcBodyNodes: TAVLTree;
172       const BodyNodeExt: TCodeTreeNodeExtension;
173       ProcAttrCopyDefToBody: TProcHeadAttributes; var ProcsCopied: boolean;
174       CaseSensitive: boolean): boolean;
UpdateProcBodySignaturesnull175     function UpdateProcBodySignatures(ProcDefNodes, ProcBodyNodes: TAVLTree;
176       ProcAttrCopyDefToBody: TProcHeadAttributes; out ProcsCopied: boolean;
177       OnlyNode: TCodeTreeNode = nil): boolean;
178     procedure GuessProcDefBodyMapping(ProcDefNodes, ProcBodyNodes: TAVLTree;
179       MapByNameOnly, MapLastOne: boolean);
GatherClassProcDefinitionsnull180     function GatherClassProcDefinitions(ClassNode: TCodeTreeNode;
181       RemoveAbstracts: boolean): TAVLTree;
GatherClassProcBodiesnull182     function GatherClassProcBodies(ClassNode: TCodeTreeNode): TAVLTree;
183     procedure CheckForOverrideAndAddInheritedCode(
184       ANodeExt: TCodeTreeNodeExtension; Indent: integer);
CompletePropertynull185     function CompleteProperty(PropNode: TCodeTreeNode): boolean;
GetFirstClassIdentifiernull186     function GetFirstClassIdentifier(ClassNode: TCodeTreeNode): TCodeTreeNode;
187     procedure SetCodeCompleteClassNode(const AClassNode: TCodeTreeNode);
188     procedure SetCodeCompleteSrcChgCache(const AValue: TSourceChangeCache);
OnTopLvlIdentifierFoundnull189     function OnTopLvlIdentifierFound(Params: TFindDeclarationParams;
190         const FoundContext: TFindContext): TIdentifierFoundResult;
191     procedure RemoveNewMainUsesSectionUnit(p: PChar);
192   protected
193     procedure CheckWholeUnitParsed(var Node1, Node2: TCodeTreeNode;
194       Range: TLinkScannerRange = lsrEnd);
195     procedure FreeClassInsertionList;
196     procedure InsertNewClassParts(PartType: TNewClassPart);
InsertAllNewClassPartsnull197     function InsertAllNewClassParts: boolean;
InsertClassHeaderCommentnull198     function InsertClassHeaderComment: boolean;
InsertMissingClassSemicolonsnull199     function InsertMissingClassSemicolons: boolean;
InsertAllNewUnitsToMainUsesSectionnull200     function InsertAllNewUnitsToMainUsesSection: boolean;
FindClassMethodsCommentnull201     function FindClassMethodsComment(StartPos: integer;
202            out CommentStart, CommentEnd: integer): boolean;
FindProcAndClassNodenull203     function FindProcAndClassNode(CursorNode: TCodeTreeNode; out ProcNode,
204       AClassNode: TCodeTreeNode): boolean;
CreateMissingClassProcBodiesnull205     function CreateMissingClassProcBodies(UpdateSignatures: boolean): boolean;
ApplyChangesAndJumpToFirstNewProcnull206     function ApplyChangesAndJumpToFirstNewProc(CleanPos: integer;
207            OldTopLine: integer; AddMissingProcBodies: boolean;
208            out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
NodeExtIsVariablenull209     function NodeExtIsVariable(ANodeExt: TCodeTreeNodeExtension): boolean;
NodeExtHasVisibiltynull210     function NodeExtHasVisibilty(ANodeExt: TCodeTreeNodeExtension;
211       Visibility: TPascalClassSection): boolean;
212     procedure FindInsertPositionForForwardProc(
213            SourceChangeCache: TSourceChangeCache;
214            ProcNode: TCodeTreeNode; out Indent, InsertPos: integer);
215     procedure FindInsertPositionForProcInterface(var Indent, InsertPos: integer;
216            SourceChangeCache: TSourceChangeCache);
CheckLocalVarAssignmentSyntaxnull217     function CheckLocalVarAssignmentSyntax(CleanCursorPos: integer;
218            out VarNameAtom,AssignmentOperator,TermAtom: TAtomPosition): boolean;
CheckLocalVarForInSyntaxnull219     function CheckLocalVarForInSyntax(CleanCursorPos: integer;
220            out VarNameAtom,TermAtom: TAtomPosition): boolean;
AddLocalVariablenull221     function AddLocalVariable(CleanCursorPos: integer; OldTopLine: integer;
222                        VariableName, VariableType, VariableTypeUnitName: string;
223                        out NewPos: TCodeXYPosition; out NewTopLine: integer;
224                        SourceChangeCache: TSourceChangeCache;
225                        CleanLevelPos: integer = 0): boolean;
226     procedure AdjustCursor(OldCodePos: TCodePosition; OldTopLine: integer;
227                           out NewPos: TCodeXYPosition; out NewTopLine: integer);
228     procedure AddNeededUnitToMainUsesSection(AnUnitName: PChar);
AddMethodCompatibleToProcTypenull229     function AddMethodCompatibleToProcType(AClassNode: TCodeTreeNode;
230                   const AnEventName: string; ProcContext: TFindContext; out
231                   MethodDefinition: string; out MethodAttr: TProcHeadAttributes;
232                   SourceChangeCache: TSourceChangeCache; Interactive: Boolean): Boolean;
233     procedure AddProcedureCompatibleToProcType(
234                   const NewProcName: string; ProcContext: TFindContext; out
235                   MethodDefinition: string; out MethodAttr: TProcHeadAttributes;
236                   SourceChangeCache: TSourceChangeCache;
237                   CursorNode: TCodeTreeNode = nil);
CompleteClassnull238     function CompleteClass(AClassNode: TCodeTreeNode;
239                            CleanCursorPos, OldTopLine: integer;
240                            CursorNode: TCodeTreeNode;
241                 var NewPos: TCodeXYPosition; var NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
CompleteForwardProcsnull242     function CompleteForwardProcs(CursorPos: TCodeXYPosition;
243                      ProcNode, CursorNode: TCodeTreeNode;
244                      var NewPos: TCodeXYPosition; var NewTopLine, BlockTopLine, BlockBottomLine: integer;
245                      SourceChangeCache: TSourceChangeCache): boolean;
CompleteVariableAssignmentnull246     function CompleteVariableAssignment(CleanCursorPos,
247                        OldTopLine: integer; CursorNode: TCodeTreeNode;
248                        var NewPos: TCodeXYPosition; var NewTopLine: integer;
249                        SourceChangeCache: TSourceChangeCache; Interactive: Boolean): boolean;
CompleteEventAssignmentnull250     function CompleteEventAssignment(CleanCursorPos,
251                        OldTopLine: integer; CursorNode: TCodeTreeNode;
252                        out IsEventAssignment: boolean;
253                        var NewPos: TCodeXYPosition; var NewTopLine: integer;
254                        SourceChangeCache: TSourceChangeCache; Interactive: Boolean): boolean;
CompleteVariableForInnull255     function CompleteVariableForIn(CleanCursorPos,
256                        OldTopLine: integer; CursorNode: TCodeTreeNode;
257                        var NewPos: TCodeXYPosition; var NewTopLine: integer;
258                        SourceChangeCache: TSourceChangeCache; {%H-}Interactive: Boolean): boolean;
CompleteIdentifierByParameternull259     function CompleteIdentifierByParameter(CleanCursorPos,
260                        OldTopLine: integer; CursorNode: TCodeTreeNode;
261                        var NewPos: TCodeXYPosition; var NewTopLine: integer;
262                        SourceChangeCache: TSourceChangeCache; Interactive: Boolean): boolean;
CompleteMethodByBodynull263     function CompleteMethodByBody(CleanCursorPos, OldTopLine: integer;
264                            CursorNode: TCodeTreeNode;
265                            var NewPos: TCodeXYPosition; var NewTopLine: integer;
266                            SourceChangeCache: TSourceChangeCache): boolean;
CreateParamListFromStatementnull267     function CreateParamListFromStatement(CursorNode: TCodeTreeNode;
268                                           BracketOpenPos: integer;
269                                           out CleanList: string): string;
CompleteProcByCallnull270     function CompleteProcByCall(CleanCursorPos, OldTopLine: integer;
271                            CursorNode: TCodeTreeNode;
272                            var NewPos: TCodeXYPosition; var NewTopLine, BlockTopLine, BlockBottomLine: integer;
273                            SourceChangeCache: TSourceChangeCache): boolean;
274   protected
275     procedure DoDeleteNodes(StartNode: TCodeTreeNode); override;
276   public
277     constructor Create;
CompleteCodenull278     function CompleteCode(CursorPos: TCodeXYPosition; OldTopLine: integer;
279                           out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer;
280                           SourceChangeCache: TSourceChangeCache;
281                           Interactive: Boolean): boolean;
CreateVariableForIdentifiernull282     function CreateVariableForIdentifier(CursorPos: TCodeXYPosition; OldTopLine: integer;
283                           out NewPos: TCodeXYPosition; out NewTopLine: integer;
284                           SourceChangeCache: TSourceChangeCache;
285                           Interactive: Boolean): boolean;
AddMethodsnull286     function AddMethods(CursorPos: TCodeXYPosition;// position in class declaration
287                         OldTopLine: integer;
288                         ListOfPCodeXYPosition: TFPList;
289                         const VirtualToOverride: boolean;
290                         out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer;
291                         SourceChangeCache: TSourceChangeCache): boolean;
AddPublishedVariablenull292     function AddPublishedVariable(const UpperClassName,VarName, VarType: string;
293                       SourceChangeCache: TSourceChangeCache): boolean; override;
294 
295     // graph of definitions of a unit
GatherUnitDefinitionsnull296     function GatherUnitDefinitions(out TreeOfCodeTreeNodeExt: TAVLTree;
297                       OnlyInterface, ExceptionOnRedefinition: boolean): boolean;
BuildUnitDefinitionGraphnull298     function BuildUnitDefinitionGraph(
299                         out DefinitionsTreeOfCodeTreeNodeExt: TAVLTree;
300                         out Graph: TCodeGraph; OnlyInterface: boolean): boolean;
301     procedure WriteCodeGraphDebugReport(Graph: TCodeGraph);
302 
303     // redefinitions
GetRedefinitionNodeTextnull304     function GetRedefinitionNodeText(Node: TCodeTreeNode): string;
FindRedefinitionsnull305     function FindRedefinitions(out TreeOfCodeTreeNodeExt: TAVLTree;
306                         WithEnums: boolean): boolean;
RemoveRedefinitionsnull307     function RemoveRedefinitions(TreeOfCodeTreeNodeExt: TAVLTree;
308                                 SourceChangeCache: TSourceChangeCache): boolean;
FindAliasDefinitionsnull309     function FindAliasDefinitions(out TreeOfCodeTreeNodeExt: TAVLTree;
310                                   OnlyWrongType: boolean): boolean;
FixAliasDefinitionsnull311     function FixAliasDefinitions(TreeOfCodeTreeNodeExt: TAVLTree;
312                                 SourceChangeCache: TSourceChangeCache): boolean;
313 
314     // const functions
FindConstFunctionsnull315     function FindConstFunctions(out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
ReplaceConstFunctionsnull316     function ReplaceConstFunctions(TreeOfCodeTreeNodeExt: TAVLTree;
317                                 SourceChangeCache: TSourceChangeCache): boolean;
FindTypeCastFunctionsnull318     function FindTypeCastFunctions(out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
319 
320     // typecast functions
ReplaceTypeCastFunctionsnull321     function ReplaceTypeCastFunctions(TreeOfCodeTreeNodeExt: TAVLTree;
322                                 SourceChangeCache: TSourceChangeCache): boolean;
MovePointerTypesToTargetSectionsnull323     function MovePointerTypesToTargetSections(
324                                 SourceChangeCache: TSourceChangeCache): boolean;
325 
326     // sort procs
FixForwardDefinitionsnull327     function FixForwardDefinitions(SourceChangeCache: TSourceChangeCache
328                                    ): boolean;
329 
330     // empty functions
FindEmptyMethodsnull331     function FindEmptyMethods(CursorPos: TCodeXYPosition;
332                               const AClassName: string; // can be ''
333                               const Sections: TPascalClassSections;
334                               ListOfPCodeXYPosition: TFPList;
335                               out AllEmpty: boolean): boolean;
FindEmptyMethodsnull336     function FindEmptyMethods(CursorPos: TCodeXYPosition;
337                               const AClassName: string; // can be ''
338                               const Sections: TPascalClassSections;
339                               CodeTreeNodeExtensions: TAVLTree;
340                               out AllEmpty: boolean): boolean;
RemoveEmptyMethodsnull341     function RemoveEmptyMethods(CursorPos: TCodeXYPosition;
342                               const AClassName: string;
343                               const Sections: TPascalClassSections;
344                               SourceChangeCache: TSourceChangeCache;
345                               out AllRemoved: boolean;
346                               const Attr: TProcHeadAttributes;
347                               out RemovedProcHeads: TStrings): boolean;
348 
349     // assign records/classes
FindAssignMethodnull350     function FindAssignMethod(CursorPos: TCodeXYPosition;
351         out ClassNode: TCodeTreeNode;
352         out AssignDeclNode: TCodeTreeNode;
353         var MemberNodeExts: TAVLTree; // tree of TCodeTreeNodeExtension, Node=var or property, Data=write property
354         out AssignBodyNode: TCodeTreeNode;
355         out InheritedDeclContext: TFindContext;
356         ProcName: string = '' // default is 'Assign'
357         ): boolean;
AddAssignMethodnull358     function AddAssignMethod(ClassNode: TCodeTreeNode; MemberNodeExts: TFPList;
359         const ProcName, ParamName, ParamType: string;
360         OverrideMod, CallInherited, CallInheritedOnlyInElse: boolean;
361         SourceChanger: TSourceChangeCache;
362         out NewPos: TCodeXYPosition; out NewTopLine: integer;
363         LocalVarName: string = '' // default is 'aSource'
364         ): boolean;
AddAssignMethodnull365     function AddAssignMethod(ClassNode: TCodeTreeNode; MemberNodeExts: TFPList;
366         const ProcName, ParamName, ParamType: string;
367         OverrideMod, CallInherited, CallInheritedOnlyInElse: boolean;
368         SourceChanger: TSourceChangeCache;
369         out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer;
370         LocalVarName: string = '' // default is 'aSource'
371         ): boolean;
372 
373     // local variables
GetPossibleInitsForVariablenull374     function GetPossibleInitsForVariable(CursorPos: TCodeXYPosition;
375         out Statements: TStrings;
376         out InsertPositions: TObjectList; // list of TInsertStatementPosDescription
377         SourceChangeCache: TSourceChangeCache = nil // needed for Beautifier
378         ): boolean;
379 
380     // guess type of an undeclared identifier
GuessTypeOfIdentifiernull381     function GuessTypeOfIdentifier(CursorPos: TCodeXYPosition;
382         out IsKeyword, IsSubIdentifier: boolean;
383         out ExistingDefinition: TFindContext; // if it already exists
384         out ListOfPFindContext: TFPList; // possible classes for adding as sub identifier
385         out NewExprType: TExpressionType; out NewType: string): boolean; // false = not at an identifier
DeclareVariableNearBynull386     function DeclareVariableNearBy(InsertPos: TCodeXYPosition;
387         const VariableName, NewType, NewUnitName: string;
388         Visibility: TCodeTreeNodeDesc;
389         SourceChangeCache: TSourceChangeCache;
390         LevelPos: TCodeXYPosition  // optional
391         ): boolean;
DeclareVariableAtnull392     function DeclareVariableAt(CursorPos: TCodeXYPosition;
393         const VariableName, NewType, NewUnitName: string;
394         SourceChangeCache: TSourceChangeCache): boolean;
395 
396     // custom class completion
InitClassCompletionnull397     function InitClassCompletion(const AClassName: string;
398                                  SourceChangeCache: TSourceChangeCache): boolean;
InitClassCompletionnull399     function InitClassCompletion(ClassNode: TCodeTreeNode;
400                                  SourceChangeCache: TSourceChangeCache): boolean;
ApplyClassCompletionnull401     function ApplyClassCompletion(AddMissingProcBodies: boolean): boolean;
ProcExistsInCodeCompleteClassnull402     function ProcExistsInCodeCompleteClass(
403         const NameAndParamsUpCase: string; SearchInAncestors: boolean = true): boolean;
FindProcInCodeCompleteClassnull404     function FindProcInCodeCompleteClass(const NameAndParamsUpCase: string;
405         SearchInAncestors: boolean = true): TFindContext;
VarExistsInCodeCompleteClassnull406     function VarExistsInCodeCompleteClass(const UpperName: string): boolean;
407     procedure AddClassInsertion(
408         const CleanDef, Def, IdentifierName: string;
409         TheType: TNewClassPart; PosNode: TCodeTreeNode = nil;
410         const Body: string = '');
411     procedure AddNeededUnitsToMainUsesSectionForRange(
412         StartPos, EndPos: integer; CompletionTool: TCodeCompletionCodeTool);
413   public
414     // Options; ToDo: move to options
415     property SetPropertyVariablename: string read FSetPropertyVariablename
416                                              write SetSetPropertyVariablename;
417     property SetPropertyVariableIsPrefix: Boolean
418       read FSetPropertyVariableIsPrefix write SetSetPropertyVariableIsPrefix;
419     property SetPropertyVariableUseConst: Boolean
420       read FSetPropertyVariableUseConst write SetSetPropertyVariableUseConst;
421     property CompleteProperties: boolean read FCompleteProperties
422                                          write FCompleteProperties;
423     property AddInheritedCodeToOverrideMethod: boolean
424                                         read FAddInheritedCodeToOverrideMethod
425                                         write FAddInheritedCodeToOverrideMethod;
426 
427     property CodeCompleteClassNode: TCodeTreeNode
428                      read FCodeCompleteClassNode write SetCodeCompleteClassNode;
429     property CodeCompleteSrcChgCache: TSourceChangeCache
430                        read FSourceChangeCache write SetCodeCompleteSrcChgCache;
431 
432     procedure CalcMemSize(Stats: TCTMemStats); override;
433   end;
434 
435 type
onstnull436   TShowCodeCreationDlgFunc = function(const ANewIdent: string; const AIsMethod: Boolean;
437     out Options: TCodeCreationDlgResult): Boolean; //in case of imsPrompt show a dialog and return a "normal" section; returns true if OK, false if canceled
438 var
439   ShowCodeCreationDlg: TShowCodeCreationDlgFunc = nil;
440 
441 implementation
442 
443 type
444   TNodeMoveEdge = class
445   public
446     GraphNode: TCodeGraphNode;
447     DestPos: integer;
448     TologicalLevel: integer;
449     SrcPos: integer;
450   end;
451 
CompareNodeMoveEdgesnull452 function CompareNodeMoveEdges(NodeMove1, NodeMove2: Pointer): integer;
453 var
454   Node1: TNodeMoveEdge;
455   Node2: TNodeMoveEdge;
456 begin
457   Node1:=TNodeMoveEdge(NodeMove1);
458   Node2:=TNodeMoveEdge(NodeMove2);
459   if Node1.DestPos>Node2.DestPos then
460     Result:=1
461   else if Node1.DestPos<Node2.DestPos then
462     Result:=-1
463   else if Node1.TologicalLevel>Node2.TologicalLevel then
464     Result:=1
465   else if Node1.TologicalLevel<Node2.TologicalLevel then
466     Result:=-1
467   else if Node1.SrcPos>Node2.SrcPos then
468     Result:=1
469   else if Node1.SrcPos<Node2.SrcPos then
470     Result:=-1
471   else
472     Result:=0;
473 end;
474 
475 
476 { TCodeCompletionCodeTool }
477 
TCodeCompletionCodeTool.ProcExistsInCodeCompleteClassnull478 function TCodeCompletionCodeTool.ProcExistsInCodeCompleteClass(
479   const NameAndParamsUpCase: string; SearchInAncestors: boolean): boolean;
480 begin
481   Result:=FindProcInCodeCompleteClass(NameAndParamsUpCase,SearchInAncestors).Node<>nil;
482 end;
483 
FindProcInCodeCompleteClassnull484 function TCodeCompletionCodeTool.FindProcInCodeCompleteClass(
485   const NameAndParamsUpCase: string; SearchInAncestors: boolean): TFindContext;
486 // NameAndParams should be uppercase and contains the proc name and the
487 // parameter list without names and default values
488 // and should not contain any comments and no result type
489 // e.g. DOIT(LONGINT;STRING)
490 var
491   ANodeExt: TCodeTreeNodeExtension;
492   Params: TFindDeclarationParams;
493   ClassNode, StartNode: TCodeTreeNode;
494   Tool: TFindDeclarationTool;
495   Vis: TClassSectionVisibility;
496 begin
497   Result:=CleanFindContext;
498   // search in new nodes, which will be inserted
499   ANodeExt:=FirstInsert;
500   while ANodeExt<>nil do begin
501     if CompareTextIgnoringSpace(ANodeExt.Txt,NameAndParamsUpCase,true)=0 then
502     begin
503       Result.Tool:=Self;
504       Result.Node:=CodeCompleteClassNode;
505       exit;
506     end;
507     ANodeExt:=ANodeExt.Next;
508   end;
509   // search in current class
510   Result.Node:=FindProcNode(FCompletingFirstEntryNode,NameAndParamsUpCase,mgMethod,
511                         [phpInUpperCase]);
512   if Result.Node<>nil then begin
513     Result.Tool:=Self;
514     exit;
515   end;
516   if not SearchInAncestors then exit;
517   //search in ancestor classes
518   Params:=TFindDeclarationParams.Create;
519   try
520     ClassNode:=CodeCompleteClassNode;
521     Tool:=Self;
522     while Tool.FindAncestorOfClass(ClassNode,Params,True) do
523     begin
524       Tool:=Params.NewCodeTool;
525       ClassNode:=Params.NewNode;
526       StartNode:=GetFirstClassIdentifier(ClassNode);
527       if Tool=Self then
528         Vis := csvPrivateAndHigher
529       else
530         Vis := csvProtectedAndHigher;
531       Result.Node := Tool.FindProcNode(StartNode,NameAndParamsUpCase,
532                                    mgMethod,[phpInUpperCase], Vis);
533       if Result.Node<>nil then begin
534         Result.Tool:=Tool;
535         exit;
536       end;
537     end;
538   finally
539     Params.Free;
540   end;
541 end;
542 
543 procedure TCodeCompletionCodeTool.SetCodeCompleteClassNode(const AClassNode: TCodeTreeNode);
544 begin
545   FreeClassInsertionList;
546   FJumpToProcHead.Name:='';
547   FCodeCompleteClassNode:=AClassNode;
548   if CodeCompleteClassNode=nil then begin
549     FCompletingFirstEntryNode:=nil;
550     exit;
551   end;
552   ClearIgnoreErrorAfter;
553   // find first variable/method/GUID
554   FCompletingFirstEntryNode:=GetFirstClassIdentifier(CodeCompleteClassNode);
555 end;
556 
557 procedure TCodeCompletionCodeTool.SetCodeCompleteSrcChgCache(
558   const AValue: TSourceChangeCache);
559 begin
560   FSourceChangeCache:=AValue;
561   FSourceChangeCache.MainScanner:=Scanner;
562 end;
563 
564 procedure TCodeCompletionCodeTool.SetSetPropertyVariableIsPrefix(aValue: Boolean
565   );
566 begin
567   if FSetPropertyVariableIsPrefix = aValue then Exit;
568   FSetPropertyVariableIsPrefix := aValue;
569 end;
570 
571 procedure TCodeCompletionCodeTool.SetSetPropertyVariablename(AValue: string);
572 begin
573   if FSetPropertyVariablename=aValue then Exit;
574   FSetPropertyVariablename:=aValue;
575 end;
576 
577 procedure TCodeCompletionCodeTool.SetSetPropertyVariableUseConst(aValue: Boolean
578   );
579 begin
580   if FSetPropertyVariableUseConst = aValue then Exit;
581   FSetPropertyVariableUseConst := aValue;
582 end;
583 
OnTopLvlIdentifierFoundnull584 function TCodeCompletionCodeTool.OnTopLvlIdentifierFound(
585   Params: TFindDeclarationParams; const FoundContext: TFindContext
586   ): TIdentifierFoundResult;
587 var
588   TrimmedIdentifier: string;
589 begin
590   if not (fdfTopLvlResolving in Params.Flags) then exit(ifrProceedSearch);
591   with FoundContext do begin
592     case Node.Desc of
593     ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnGenericType:
594       TrimmedIdentifier:=Tool.ExtractDefinitionName(Node);
595     ctnProperty:
596       TrimmedIdentifier:=Tool.ExtractPropName(Node,false);
597     else
598       TrimmedIdentifier:=GetIdentifier(Params.Identifier);
599     end;
600   end;
601   fFullTopLvlName:=fFullTopLvlName+TrimmedIdentifier;
602   Result:=ifrSuccess;
603 end;
604 
605 procedure TCodeCompletionCodeTool.RemoveNewMainUsesSectionUnit(p: PChar);
606 var
607   AVLNode: TAVLTreeNode;
608   s: string;
609 begin
610   if fNewMainUsesSectionUnits=nil then exit;
611   AVLNode:=fNewMainUsesSectionUnits.Find(p);
612   if AVLNode=nil then exit;
613   Pointer(s):=AVLNode.Data;
614   s:='';
615   fNewMainUsesSectionUnits.Delete(AVLNode);
616   if s='' then ;
617 end;
618 
619 procedure TCodeCompletionCodeTool.CheckWholeUnitParsed(var Node1,
620   Node2: TCodeTreeNode; Range: TLinkScannerRange);
621 var
622   Pos1: Integer;
623   Pos2: Integer;
624 begin
625   //DebugLn(['TCodeCompletionCodeTool.CheckWholeUnitParsed ',EndOfSourceFound,' LastErrorMessage="',LastErrorMessage,'" LastErrorCurPos=',dbgs(LastErrorCurPos)]);
626   if (ScannedRange>=Range) and (not LastErrorValid) then exit;
627   Pos1:=0;
628   Pos2:=0;
629   if Node1<>nil then Pos1:=Node1.StartPos;
630   if Node2<>nil then Pos2:=Node2.StartPos;
631   ClearIgnoreErrorAfter;
632   BuildTree(Range);
633   if Node1<>nil then Node1:=FindDeepestNodeAtPos(Pos1,true);
634   if Node2<>nil then Node2:=FindDeepestNodeAtPos(Pos2,true);
635 end;
636 
VarExistsInCodeCompleteClassnull637 function TCodeCompletionCodeTool.VarExistsInCodeCompleteClass(
638   const UpperName: string): boolean;
639 var
640   ANodeExt: TCodeTreeNodeExtension;
641   Params: TFindDeclarationParams;
642   ClassNode, CompletingChildNode: TCodeTreeNode;
643   Tool: TFindDeclarationTool;
644   Vis: TClassSectionVisibility;
645 begin
646   Result:=false;
647   // search in new nodes, which will be inserted
648   ANodeExt:=FirstInsert;
649   while ANodeExt<>nil do begin
650     if CompareTextIgnoringSpace(ANodeExt.Txt,UpperName,true)=0 then
651       exit(true);
652     ANodeExt:=ANodeExt.Next;
653   end;
654   // search in current class
655   Result:=(FindVarNode(FCompletingFirstEntryNode,UpperName)<>nil);
656   if not Result then
657   begin
658     //search in ancestor classes
659     Params:=TFindDeclarationParams.Create;
660     try
661       ClassNode:=CodeCompleteClassNode;
662       Tool:=Self;
663       while not Result and Tool.FindAncestorOfClass(ClassNode,Params,True) do begin
664         Tool:=Params.NewCodeTool;
665         ClassNode:=Params.NewNode;
666         CompletingChildNode:=GetFirstClassIdentifier(ClassNode);
667         if Tool=Self then
668           Vis := csvPrivateAndHigher
669         else
670           Vis := csvProtectedAndHigher;
671         Result := (Tool.FindVarNode(CompletingChildNode,UpperName,Vis)<>nil);
672       end;
673     finally
674       Params.Free;
675     end;
676   end;
677 end;
678 
679 procedure TCodeCompletionCodeTool.AddClassInsertion(
680   const CleanDef, Def, IdentifierName: string; TheType: TNewClassPart;
681   PosNode: TCodeTreeNode; const Body: string);
682 { add an insert request entry to the list of insertions
683   For example: a request to insert a new variable or a new method to the class
684 
685   CleanDef:  The skeleton of the new insertion. e.g. the variablename or the
686              method header without parameter names.
687   Def:       The insertion code.
688   IdentifierName: e.g. the variablename or the method name
689   TheType:   see TNewClassPart
690   PosNode:   optional. The node, to which the request belongs. e.g. the
691              property node, if the insert is the auto created private variable.
692   Body:      optional. Normally a method body is auto created. This overrides
693              the body code.
694 
695 }
696 var NewInsert, InsertPos, LastInsertPos: TCodeTreeNodeExtension;
697   Beauty: TBeautifyCodeOptions;
698 begin
699   {$IFDEF CTDEBUG}
700   DebugLn('[TCodeCompletionCodeTool.AddClassInsertion] CleanDef="',CleanDef,'" Def="',Def,'" Identifiername="',Identifiername,'" Body="',Body,'"');
701   {$ENDIF}
702   if CodeCompleteClassNode.Desc in AllClassInterfaces then begin
703     // a class interface has no section -> put them all into 'public'
704     if TheType in NewClassPartProcs then
705       TheType:=ncpPublicProcs
706     else if TheType in NewClassPartVars then
707       raise Exception.Create('TCodeCompletionCodeTool.AddClassInsertion can not add variables to a class interface');
708   end;
709 
710   NewInsert:=TCodeTreeNodeExtension.Create;
711   with NewInsert do begin
712     Node:=PosNode;
713     Txt:=CleanDef;
714     ExtTxt1:=Def;
715     ExtTxt2:=IdentifierName;
716     ExtTxt3:=Body;
717     Flags:=ord(TheType);
718   end;
719   if FirstInsert=nil then begin
720     FirstInsert:=NewInsert;
721     exit;
722   end;
723   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
724   if Beauty.ClassPartInsertPolicy=cpipLast then
725   begin
726     // add as last to inserts
727     InsertPos:=FirstInsert;
728     while (InsertPos.Next<>nil) do
729       InsertPos:=InsertPos.Next;
730     InsertPos.Next:=NewInsert;
731   end else begin
732     // insert alphabetically
733     InsertPos:=FirstInsert;
734     LastInsertPos:=nil;
735     //DebugLn('GGG "',InsertPos.Txt,'" "',CleanDef,'" ',CompareTextIgnoringSpace(InsertPos.Txt,CleanDef,false));
736     while (InsertPos<>nil)
737     and (CompareTextIgnoringSpace(InsertPos.Txt,CleanDef,false)>=0) do begin
738       LastInsertPos:=InsertPos;
739       InsertPos:=InsertPos.Next;
740     end;
741     if LastInsertPos<>nil then begin
742       // insert after LastInsertPos
743       NewInsert.Next:=LastInsertPos.Next;
744       LastInsertPos.Next:=NewInsert;
745     end else begin
746       // insert as first
747       NewInsert.Next:=InsertPos;
748       FirstInsert:=NewInsert;
749     end;
750     {InsertPos:=FirstInsert;
751     while InsertPos<>nil do begin
752       DebugLn(' HHH ',InsertPos.Txt);
753       InsertPos:=InsertPos.Next;
754     end;}
755   end;
756 end;
757 
758 procedure TCodeCompletionCodeTool.FreeClassInsertionList;
759 // dispose all new variables/procs definitions
760 var
761   ANodeExt: TCodeTreeNodeExtension;
762   AVLNode: TAVLTreeNode;
763   s: string;
764 begin
765   while FirstInsert<>nil do begin
766     ANodeExt:=FirstInsert;
767     FirstInsert:=FirstInsert.Next;
768     ANodeExt.Free;
769   end;
770   if fNewMainUsesSectionUnits<>nil then begin
771     AVLNode:=fNewMainUsesSectionUnits.FindLowest;
772     while AVLNode<>nil do begin
773       Pointer(s):=AVLNode.Data;
774       s:='';
775       AVLNode:=fNewMainUsesSectionUnits.FindSuccessor(AVLNode);
776     end;
777     if s='' then ;
778     FreeAndNil(fNewMainUsesSectionUnits);
779   end;
780 end;
781 
TCodeCompletionCodeTool.NodeExtIsVariablenull782 function TCodeCompletionCodeTool.NodeExtIsVariable(
783   ANodeExt: TCodeTreeNodeExtension): boolean;
784 begin
785   Result:=TNewClassPart(ANodeExt.Flags) in NewClassPartVars;
786 end;
787 
NodeExtHasVisibiltynull788 function TCodeCompletionCodeTool.NodeExtHasVisibilty(
789   ANodeExt: TCodeTreeNodeExtension; Visibility: TPascalClassSection): boolean;
790 begin
791   case Visibility of
792   pcsPrivate:
793     Result:=(ANodeExt.Flags=ord(ncpPrivateVars))
794          or (ANodeExt.Flags=ord(ncpPrivateProcs));
795   pcsProtected:
796     Result:=(ANodeExt.Flags=ord(ncpProtectedVars))
797          or (ANodeExt.Flags=ord(ncpProtectedProcs));
798   pcsPublic:
799     Result:=(ANodeExt.Flags=ord(ncpPublicVars))
800          or (ANodeExt.Flags=ord(ncpPublicProcs));
801   pcsPublished:
802     Result:=(ANodeExt.Flags=ord(ncpPublishedVars))
803          or (ANodeExt.Flags=ord(ncpPublishedProcs));
804   else
805     Result:=false;
806   end;
807 end;
808 
809 procedure TCodeCompletionCodeTool.FindInsertPositionForForwardProc(
810   SourceChangeCache: TSourceChangeCache; ProcNode: TCodeTreeNode; out Indent,
811   InsertPos: integer);
812 var
813   Beauty: TBeautifyCodeOptions;
814 
815   procedure SetIndentAndInsertPos(Node: TCodeTreeNode; Behind: boolean);
816   begin
817     Indent:=Beauty.GetLineIndent(Src,Node.StartPos);
818     if Behind then
819       InsertPos:=FindLineEndOrCodeAfterPosition(Node.EndPos)
820     else
821       InsertPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
822   end;
823 
824 var
825   NearestProcNode, StartSearchProc: TCodeTreeNode;
826   IsInInterface: boolean;
827   ProcBodyNodes, ForwardProcNodes: TAVLTree; // tree of TCodeTreeNodeExtension
828   ProcAVLNode, NearestAVLNode: TAVLTreeNode;
829   ProcNodeExt, NearestNodeExt: TCodeTreeNodeExtension;
830   InsertBehind: boolean;
831   NearestAVLNodeInFront: TAVLTreeNode;
832   NearestAVLNodeBehind: TAVLTreeNode;
833   ProcPosInFront: Integer;
834   ProcPosBehind: Integer;
835   EmptyLinesInFront: Integer;
836   EmptyLinesBehind: Integer;
837 begin
838   Indent:=0;
839   InsertPos:=0;
840   Beauty:=SourceChangeCache.BeautifyCodeOptions;
841   IsInInterface:=ProcNode.HasParentOfType(ctnInterface);
842   if IsInInterface then begin
843     // forward proc in interface
844     StartSearchProc:=FindImplementationNode;
845     if StartSearchProc=nil then
846       RaiseException(20170421201438,'Implementation section not found');
847     if StartSearchProc.FirstChild<>nil then begin
848       // implementation not empty
849       StartSearchProc:=StartSearchProc.FirstChild
850     end else begin
851       // implementation is empty
852       // -> add it as first body
853       Indent:=Beauty.GetLineIndent(Src,StartSearchProc.StartPos);
854       InsertPos:=StartSearchProc.StartPos+length('implementation');
855       exit;
856     end;
857   end else begin
858     // forward proc in code
859     // start searching for bodies behind proc
860     StartSearchProc:=ProcNode.NextBrother;
861     if StartSearchProc=nil then begin
862       // There are no nodes behind
863       // -> insert code directly behind
864       SetIndentAndInsertPos(ProcNode,true);
865       exit;
866     end;
867   end;
868 
869   //debugln(['TCodeCompletionCodeTool.FindInsertPositionForForwardProc ',ord(Beauty.ForwardProcBodyInsertPolicy)]);
870   if Beauty.KeepForwardProcOrder then begin
871     // KeepForwardProcOrder: gather all procs and try to insert the new body
872     //  in the same order of other forward proc definitions.
873     ForwardProcNodes:=nil;
874     ProcAVLNode:=nil;
875     ProcBodyNodes:=nil;
876     ProcNodeExt:=nil;
877 
878     try
879       // gather all forward procs definitions on the same level
880       ForwardProcNodes:=GatherProcNodes(ProcNode.Parent.FirstChild,
881                  [phpInUpperCase,phpIgnoreProcsWithBody,phpIgnoreMethods],'');
882 
883       // gather all proc bodies
884       ProcBodyNodes:=GatherProcNodes(StartSearchProc,
885                      [phpInUpperCase,phpIgnoreForwards,phpIgnoreMethods],'');
886 
887       // remove current forward proc from tree
888       ProcAVLNode:=FindAVLNodeWithNode(ForwardProcNodes,ProcNode);
889       if ProcAVLNode=nil then
890         RaiseException(20170421201441,'TCodeCompletionCodeTool.FindInsertPositionForForwardProc '
891          +' Internal Error, current forward proc not found');
892       ProcNodeExt:=TCodeTreeNodeExtension(ProcAVLNode.Data);
893       ForwardProcNodes.Delete(ProcAVLNode);
894 
895       // remove all forward procs without bodies
896       IntersectProcNodes(ForwardProcNodes,ProcBodyNodes,true);
897 
898       // sort forward proc definitions with source position
899       ForwardProcNodes.OnCompare:=@CompareCodeTreeNodeExtWithNodeStartPos;
900 
901       // For debugging:
902       {ProcAVLNode:=ForwardProcNodes.FindLowest;
903       while ProcAVLNode<>nil do begin
904         NearestProcNode:=TCodeTreeNodeExtension(ProcAVLNode.Data).Node;
905         DebugLn(['FindInsertPositionForForwardProc B ',NearestProcNode.StartPos,' "',copy(Src,NearestProcNode.StartPos,20),'"']);
906         ProcAVLNode:=ForwardProcNodes.FindSuccessor(ProcAVLNode);
907       end;}
908 
909       // find nearest forward procs (distance measured in chars)
910       NearestAVLNode:=ForwardProcNodes.FindNearest(ProcNodeExt);
911       if NearestAVLNode<>nil then begin
912 
913         //DebugLn('FindInsertPositionForForwardProc Nearest ',TCodeTreeNodeExtension(NearestAVLNode.Data).Node.StartPos,' ',ProcNode.StartPos);
914 
915         // find nearest forward procs in front and after
916         if TCodeTreeNodeExtension(NearestAVLNode.Data).Node.StartPos
917           <ProcNode.StartPos
918         then begin
919           NearestAVLNodeInFront:=NearestAVLNode;
920           NearestAVLNodeBehind:=ForwardProcNodes.FindPrecessor(NearestAVLNode);
921         end else begin
922           NearestAVLNodeInFront:=ForwardProcNodes.FindSuccessor(NearestAVLNode);
923           NearestAVLNodeBehind:=NearestAVLNode;
924         end;
925 
926         // choose the nearest of both (distance measured in empty lines,
927         // this way blocks of procs are kept)
928         if (NearestAVLNodeInFront<>nil) and (NearestAVLNodeBehind<>nil) then
929         begin
930           ProcPosInFront:=
931                TCodeTreeNodeExtension(NearestAVLNodeInFront.Data).Node.StartPos;
932           ProcPosBehind:=
933                TCodeTreeNodeExtension(NearestAVLNodeBehind.Data).Node.StartPos;
934           EmptyLinesInFront:=EmptyCodeLineCount(Src,
935                        ProcPosInFront,ProcNode.StartPos,Scanner.NestedComments);
936           EmptyLinesBehind:=EmptyCodeLineCount(Src,
937                         ProcNode.StartPos,ProcPosBehind,Scanner.NestedComments);
938           //DebugLn('FindInsertPositionForForwardProc Nearest InFront or After: EmptyLinesInFront=',EmptyLinesInFront,' EmptyLinesBehind=',EmptyLinesBehind);
939           if EmptyLinesInFront<EmptyLinesBehind then
940             NearestAVLNode:=NearestAVLNodeInFront
941           else
942             NearestAVLNode:=NearestAVLNodeBehind;
943         end;
944 
945         NearestNodeExt:=TCodeTreeNodeExtension(NearestAVLNode.Data);
946         NearestProcNode:=NearestNodeExt.Node;
947 
948         //DebugLn('FindInsertPositionForForwardProc C ',NearestProcNode.StartPos,' "',copy(Src,NearestProcNode.StartPos,20),'"');
949         InsertBehind:=NearestProcNode.StartPos<ProcNode.StartPos;
950 
951         // the corresponding body was linked by IntersectProcNodes in Data
952         NearestAVLNode:=TAVLTreeNode(NearestNodeExt.Data);
953         NearestNodeExt:=TCodeTreeNodeExtension(NearestAVLNode.Data);
954         NearestProcNode:=NearestNodeExt.Node;
955         SetIndentAndInsertPos(NearestProcNode,InsertBehind);
956         exit;
957       end else begin
958         // there is no other proc => use ForwardProcBodyInsertPolicy
959       end;
960 
961     finally
962       // clean up
963       ProcNodeExt.Free;
964       DisposeAVLTree(ProcBodyNodes);
965       DisposeAVLTree(ForwardProcNodes);
966     end;
967   end;
968 
969   if Beauty.ForwardProcBodyInsertPolicy = fpipInFrontOfMethods
970   then begin
971     // Try to insert new proc in front of existing methods
972 
973     // find first method
974     NearestProcNode:=StartSearchProc;
975     while (NearestProcNode<>nil) and (not NodeIsMethodBody(NearestProcNode)) do
976       NearestProcNode:=NearestProcNode.NextBrother;
977     if NearestProcNode<>nil then begin
978       // the comments in front of the first method probably belong to the class
979       // Therefore insert behind the node in front of the first method
980       if NearestProcNode.PriorBrother<>nil then
981         SetIndentAndInsertPos(NearestProcNode.PriorBrother,true)
982       else begin
983         Indent:=Beauty.GetLineIndent(Src,NearestProcNode.StartPos);
984         InsertPos:=NearestProcNode.Parent.StartPos;
985         while (InsertPos<=NearestProcNode.StartPos)
986         and (not IsSpaceChar[Src[InsertPos]]) do
987           inc(InsertPos);
988       end;
989       exit;
990     end;
991   end else if Beauty.ForwardProcBodyInsertPolicy = fpipBehindMethods
992   then begin
993     // Try to insert new proc behind existing methods
994 
995     // find last method (go to last brother and search backwards)
996     NearestProcNode:=StartSearchProc;
997     while (NearestProcNode.NextBrother<>nil) do
998       NearestProcNode:=NearestProcNode.NextBrother;
999     while (NearestProcNode<>nil) and (not NodeIsMethodBody(NearestProcNode)) do
1000       NearestProcNode:=NearestProcNode.PriorBrother;
1001     if NearestProcNode<>nil then begin
1002       SetIndentAndInsertPos(NearestProcNode,true);
1003       exit;
1004     end;
1005   end;
1006 
1007   // Default position: Insert behind last node
1008   NearestProcNode:=StartSearchProc;
1009   while (NearestProcNode.NextBrother<>nil) do
1010     NearestProcNode:=NearestProcNode.NextBrother;
1011   if NearestProcNode<>nil then begin
1012     SetIndentAndInsertPos(NearestProcNode,true);
1013     exit;
1014   end;
1015 
1016   RaiseException(20170421201444,'TCodeCompletionCodeTool.FindInsertPositionForForwardProc '
1017    +' Internal Error: no insert position found');
1018 end;
1019 
1020 procedure TCodeCompletionCodeTool.FindInsertPositionForProcInterface(
1021   var Indent, InsertPos: integer; SourceChangeCache: TSourceChangeCache);
1022 var
1023   InsertNode: TCodeTreeNode;
1024   Beauty: TBeautifyCodeOptions;
1025 begin
1026   Beauty:=SourceChangeCache.BeautifyCodeOptions;
1027   InsertNode:=FindInterfaceNode;
1028   if InsertNode<>nil then begin
1029     // there is an interface
1030     // -> append at end of interface
1031     InsertPos:=FindLineEndOrCodeInFrontOfPosition(InsertNode.EndPos,true);
1032     Indent:=Beauty.GetLineIndent(Src,InsertNode.EndPos);
1033   end;
1034   if InsertPos<1 then begin
1035     // there is no interface
1036     // -> insert in front of any proc
1037     InsertNode:=FindFirstSectionChild;
1038     while (InsertNode<>nil) and (InsertNode.Desc<>ctnProcedure) do
1039       InsertNode:=InsertNode.NextBrother;
1040     if InsertNode<>nil then begin
1041       InsertPos:=FindLineEndOrCodeInFrontOfPosition(InsertNode.StartPos,true);
1042       Indent:=Beauty.GetLineIndent(Src,InsertPos);
1043     end;
1044   end;
1045   if InsertPos<1 then begin
1046     InsertNode:=FindFirstSectionChild;
1047     if (InsertNode<>nil) and (InsertNode.Desc=ctnSrcName) then
1048       InsertNode:=InsertNode.NextBrother;
1049     if InsertNode<>nil then begin
1050       Indent:=Beauty.GetLineIndent(Src,InsertNode.StartPos);
1051       if InsertNode.Desc=ctnUsesSection then
1052         // insert behind uses section
1053         InsertPos:=FindLineEndOrCodeAfterPosition(InsertNode.EndPos)
1054       else
1055         // insert as first
1056         InsertPos:=FindLineEndOrCodeInFrontOfPosition(InsertNode.StartPos);
1057     end else begin
1058       // insert in interface or somewhere at start
1059       InsertNode:=Tree.Root;
1060       InsertPos:=FindLineEndOrCodeInFrontOfPosition(InsertNode.EndPos,true);
1061       Indent:=Beauty.GetLineIndent(Src,InsertNode.EndPos);
1062     end;
1063   end;
1064 end;
1065 
FindProcAndClassNodenull1066 function TCodeCompletionCodeTool.FindProcAndClassNode(CursorNode: TCodeTreeNode;
1067   out ProcNode, AClassNode: TCodeTreeNode): boolean;
1068 var
1069   ANode: TCodeTreeNode;
1070   SearchedClassName: string;
1071 begin
1072   Result:=false;
1073   AClassNode:=nil;
1074   ProcNode:=CursorNode;
1075   while (ProcNode<>nil) do begin
1076     if (ProcNode.Desc=ctnProcedure) then begin
1077       SearchedClassname:=ExtractClassNameOfProcNode(ProcNode,true);
1078       if SearchedClassName<>'' then break;
1079     end;
1080     ProcNode:=ProcNode.Parent;
1081   end;
1082   if (ProcNode=nil) then exit;
1083   ANode:=FindClassNodeForMethodBody(ProcNode,true,false);
1084   if (ANode=nil) then exit;
1085   // search class node
1086   while ANode<>nil do begin
1087     if ANode.Desc in AllClassObjects then break;
1088     ANode:=ANode.Parent;
1089   end;
1090   if ANode=nil then exit;
1091   AClassNode:=ANode;
1092   Result:=true;
1093 end;
1094 
CheckLocalVarAssignmentSyntaxnull1095 function TCodeCompletionCodeTool.CheckLocalVarAssignmentSyntax(
1096   CleanCursorPos: integer; out VarNameAtom, AssignmentOperator,
1097   TermAtom: TAtomPosition): boolean;
1098 // check for VarName:=Term
1099 begin
1100   Result:=false;
1101   MoveCursorToCleanPos(CleanCursorPos);
1102 
1103   // find variable name
1104   GetIdentStartEndAtPosition(Src,CleanCursorPos,
1105     VarNameAtom.StartPos,VarNameAtom.EndPos);
1106   //debugln('TCodeCompletionCodeTool.CheckLocalVarAssignmentSyntax VarNameAtom="',dbgstr(Src,VarNameAtom.StartPos,VarNameAtom.EndPos-VarNameAtom.StartPos),'"');
1107   if VarNameAtom.StartPos=VarNameAtom.EndPos then exit;
1108   MoveCursorToAtomPos(VarNameAtom);
1109   if AtomIsKeyWord then exit;
1110 
1111   // find assignment operator
1112   ReadNextAtom;
1113   if not (AtomIs(':=') or AtomIs('+=') or AtomIs('-=') or AtomIs('*=')
1114     or AtomIs('/=')) then exit;
1115   AssignmentOperator:=CurPos;
1116   //debugln('TCodeCompletionCodeTool.CheckLocalVarAssignmentSyntax AssignmentOperator="',dbgstr(Src,AssignmentOperator.StartPos,AssignmentOperator.EndPos-AssignmentOperator.StartPos),'"');
1117 
1118   // find term
1119   ReadNextAtom;
1120   TermAtom.StartPos:=CurPos.StartPos;
1121   TermAtom.EndPos:=FindEndOfExpression(TermAtom.StartPos);
1122   //debugln('TCodeCompletionCodeTool.CheckLocalVarAssignmentSyntax TermAtom="',dbgstr(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"');
1123 
1124   Result:=TermAtom.EndPos>TermAtom.StartPos;
1125 end;
1126 
TCodeCompletionCodeTool.CheckLocalVarForInSyntaxnull1127 function TCodeCompletionCodeTool.CheckLocalVarForInSyntax(
1128   CleanCursorPos: integer; out VarNameAtom, TermAtom: TAtomPosition): boolean;
1129 // check for: for VarName in Term do
1130 {off $DEFINE VerboseForInCompletion}
1131 var
1132   InAtomEndPos: LongInt;
1133 begin
1134   Result:=false;
1135   MoveCursorToCleanPos(CleanCursorPos);
1136 
1137   // find variable name
1138   GetIdentStartEndAtPosition(Src,CleanCursorPos,
1139     VarNameAtom.StartPos,VarNameAtom.EndPos);
1140   //debugln('TCodeCompletionCodeTool.CheckLocalVarForInSyntax A ',GetAtom(VarNameAtom),' "',copy(Src,CleanCursorPos,10),'"');
1141   if VarNameAtom.StartPos=VarNameAtom.EndPos then begin
1142     {$IFDEF VerboseForInCompletion}
1143     debugln('TCodeCompletionCodeTool.CheckLocalVarForInSyntax no identifier at cursor ',GetAtom(VarNameAtom),' "',copy(Src,CleanCursorPos,10),'"');
1144     {$ENDIF}
1145     exit;
1146   end;
1147   MoveCursorToAtomPos(VarNameAtom);
1148   if AtomIsKeyWord then exit;
1149 
1150   // find 'in' operator
1151   ReadNextAtom;
1152   if not UpAtomIs('IN') then begin
1153     {$IFDEF VerboseForInCompletion}
1154     debugln('TCodeCompletionCodeTool.CheckLocalVarForInSyntax no in keyword ',GetAtom(VarNameAtom));
1155     {$ENDIF}
1156     exit;
1157   end;
1158   InAtomEndPos:=CurPos.EndPos;
1159 
1160   // find 'for' keyword
1161   MoveCursorToCleanPos(VarNameAtom.StartPos);
1162   ReadPriorAtom;
1163   if not UpAtomIs('FOR') then begin
1164     {$IFDEF VerboseForInCompletion}
1165     debugln('TCodeCompletionCodeTool.CheckLocalVarForInSyntax no for keyword ',GetAtom);
1166     {$ENDIF}
1167     exit;
1168   end;
1169 
1170   // find term
1171   MoveCursorToCleanPos(InAtomEndPos);
1172   ReadNextAtom;
1173   TermAtom.StartPos:=CurPos.StartPos;
1174   TermAtom.EndPos:=FindEndOfExpression(TermAtom.StartPos);
1175 
1176   {$IFDEF VerboseForInCompletion}
1177   debugln('TCodeCompletionCodeTool.CheckLocalVarForInSyntax term="',GetAtom(TermAtom),'"');
1178   {$ENDIF}
1179   Result:=TermAtom.EndPos>TermAtom.StartPos;
1180 end;
1181 
AddLocalVariablenull1182 function TCodeCompletionCodeTool.AddLocalVariable(CleanCursorPos: integer;
1183   OldTopLine: integer; VariableName, VariableType,
1184   VariableTypeUnitName: string; out NewPos: TCodeXYPosition;
1185   out NewTopLine: integer; SourceChangeCache: TSourceChangeCache;
1186   CleanLevelPos: integer): boolean;
1187 // if CleanLevelPos<1 then CleanLevelPos:=CleanCursorPos
1188 // CleanLevelPos selects the target node, e.g. a ctnProcedure
1189 
1190   function FindFirstVarDeclaration(var Node: TCodeTreeNode): TCodeTreeNode;
1191   begin
1192     Result := Node;
1193     while Assigned(Result.PriorBrother) and (Result.PriorBrother.Desc = ctnVarDefinition) and
1194       not Assigned(Result.PriorBrother.LastChild)
1195     do
1196       Result := Result.PriorBrother;
1197   end;
1198 
1199 var
1200   CursorNode, VarSectionNode, VarNode: TCodeTreeNode;
1201   Indent, InsertPos: integer;
1202   InsertTxt: string;
1203   OldCodePos: TCodePosition;
1204   Node: TCodeTreeNode;
1205   ParentNode: TCodeTreeNode;
1206   OtherSectionNode: TCodeTreeNode;
1207   HeaderNode: TCodeTreeNode;
1208   Beauty: TBeautifyCodeOptions;
1209   VarTypeNode: TCodeTreeNode;
1210   InsertVarLineStart: integer;
1211   InsertVarLineEnd: integer;
1212   InsertAsNewLine: Boolean;
1213 begin
1214   Result:=false;
1215   if CleanLevelPos<1 then CleanLevelPos:=CleanCursorPos;
1216   //DebugLn('TCodeCompletionCodeTool.AddLocalVariable START CleanCursorPos=',CleanPosToStr(CleanCursorPos),' CleanLevelPos=',CleanPosToStr(CleanLevelPos));
1217   if not CleanPosToCodePos(CleanCursorPos,OldCodePos) then begin
1218     RaiseException(20170421201447,'TCodeCompletionCodeTool.AddLocalVariable Internal Error: '
1219       +'CleanPosToCodePos');
1220   end;
1221   Beauty:=SourceChangeCache.BeautifyCodeOptions;
1222 
1223   // find the level and find sections in front
1224   Node:=Tree.Root;
1225   CursorNode:=nil;
1226   VarSectionNode:=nil;
1227   OtherSectionNode:=nil;
1228   HeaderNode:=nil;
1229   ParentNode:=nil;
1230   while Node<>nil do begin
1231     if Node.StartPos>CleanCursorPos then break;
1232     CursorNode:=Node;
1233     if Node.Desc in [ctnProcedureHead,ctnUsesSection] then
1234       HeaderNode:=Node
1235     else if Node.Desc=ctnVarSection then
1236       VarSectionNode:=Node
1237     else if Node.Desc in AllDefinitionSections then
1238       OtherSectionNode:=Node;
1239     if (Node.StartPos<=CleanLevelPos)
1240     and ((Node.EndPos>CleanLevelPos)
1241       or ((Node.EndPos=CleanLevelPos)
1242          and ((Node.NextBrother=nil) or (Node.NextBrother.StartPos>CleanLevelPos))))
1243     then begin
1244       if Node.Desc in [ctnInterface,ctnImplementation,ctnProgram,ctnLibrary,
1245         ctnPackage,ctnProcedure]
1246       then begin
1247         // this node can have a var section
1248         VarSectionNode:=nil;
1249         OtherSectionNode:=nil;
1250         HeaderNode:=nil;
1251         ParentNode:=Node;
1252       end else if Node.Desc=ctnUnit then begin
1253         // the grand children can have a var section
1254       end else begin
1255         break;
1256       end;
1257       Node:=Node.FirstChild;
1258     end else
1259       Node:=Node.NextBrother;
1260   end;
1261 
1262   if ParentNode=nil then begin
1263     // no target for a var
1264     RaiseException(20170421201449,'TCodeCompletionCodeTool.AddLocalVariable Internal Error: '
1265       +'invalid target for a var');
1266   end;
1267 
1268 {$IFDEF EnableCodeCompleteTemplates}
1269   if ( CTTemplateExpander <> nil )
1270   and CTTemplateExpander.TemplateExists('PrettyColon') then
1271   begin
1272     InsertTxt:=VariableName+CTTemplateExpander.Expand('PrettyColon','','',[],[])
1273                        +VariableType+';';
1274   end
1275   else
1276 {$ENDIF}
1277   begin
1278     InsertTxt:=VariableName+':'+VariableType+';';
1279   //DebugLn(['TCodeCompletionCodeTool.AddLocalVariable C InsertTxt="',InsertTxt,'" ParentNode=',ParentNode.DescAsString,' HeaderNode=',HeaderNode.DescAsString,' OtherSectionNode=',OtherSectionNode.DescAsString,' VarSectionNode=',VarSectionNode.DescAsString,' CursorNode=',CursorNode.DescAsString]);
1280   end;
1281 
1282   InsertAsNewLine := True;
1283   if (VarSectionNode<>nil) then begin
1284     //debugln(['TCodeCompletionCodeTool.AddLocalVariable insert into existing var section']);
1285     // there is already a var section
1286     // -> first check if variables with the same type are defined (search backwards)
1287     VarTypeNode := nil;
1288     if Beauty.GroupLocalVariables then
1289     begin
1290       VarNode:=VarSectionNode.LastChild;
1291       while Assigned(VarNode) and not Assigned(VarTypeNode) do
1292       begin
1293         if (VarNode.Desc = ctnVarDefinition) and Assigned(VarNode.LastChild) and
1294            (VarNode.LastChild.Desc = ctnIdentifier) and
1295            (CompareTextIgnoringSpace(VariableType,ExtractNode(VarNode.LastChild,[phpCommentsToSpace]),False) = 0)
1296         then
1297           VarTypeNode := VarNode;
1298         VarNode := VarNode.PriorBrother;
1299       end;
1300     end;
1301     if Assigned(VarTypeNode) then
1302     begin
1303       // -> append variable to already defined line
1304       VarNode := FindFirstVarDeclaration(VarTypeNode);//find starting indentation
1305       Indent:=Beauty.GetLineIndent(Src,VarTypeNode.StartPos);
1306       if PositionsInSameLine(Src,VarTypeNode.StartPos,VarNode.StartPos) then
1307         inc(Indent,Beauty.Indent);
1308       MoveCursorToNodeStart(VarTypeNode.LastChild);
1309       ReadPriorAtom;
1310       if CurPos.Flag = cafColon then
1311       begin
1312         InsertPos:=CurPos.StartPos;
1313         GetLineStartEndAtPosition(Src, InsertPos, InsertVarLineStart, InsertVarLineEnd);
1314         InsertTxt:=VariableName;
1315         if InsertPos-InsertVarLineStart+Length(VariableName)+2 > Beauty.LineLength then//the variable name doesn't fit into the line
1316           InsertTxt := Beauty.LineEnd + Beauty.GetIndentStr(Indent) + InsertTxt
1317         else if InsertVarLineEnd-InsertVarLineStart+Length(VariableName)+2 > Beauty.LineLength then//the variable type doesn't fit into the line
1318         begin
1319           if atColon in Beauty.DoNotSplitLineInFront then
1320             InsertTxt := Beauty.LineEnd + Beauty.GetIndentStr(Indent) + InsertTxt
1321           else
1322             InsertTxt := InsertTxt + Beauty.LineEnd + Beauty.GetIndentStr(Indent);
1323         end;
1324         InsertTxt:=','+InsertTxt;
1325         Indent := 0;
1326         InsertAsNewLine := False;
1327       end else
1328         VarTypeNode := nil;//error: colon not found, insert as new line
1329     end;
1330     if not Assigned(VarTypeNode) then
1331     begin
1332       // -> append variable to new line
1333       VarNode:=VarSectionNode.LastChild;
1334       if VarNode<>nil then begin
1335         InsertPos:=FindLineEndOrCodeAfterPosition(VarNode.EndPos);
1336         VarNode := FindFirstVarDeclaration(VarNode);//find indentation of first var definition
1337         Indent:=Beauty.GetLineIndent(Src,VarNode.StartPos);
1338         if PositionsInSameLine(Src,VarSectionNode.StartPos,VarNode.StartPos) then
1339           inc(Indent,Beauty.Indent);
1340       end else begin
1341         Indent:=Beauty.GetLineIndent(Src,VarSectionNode.StartPos)+Beauty.Indent;
1342         MoveCursorToNodeStart(VarSectionNode);
1343         ReadNextAtom;
1344         InsertPos:=CurPos.EndPos;
1345       end;
1346     end;
1347   end else begin
1348     // there is no var section yet
1349     // -> create a new var section and append variable
1350     if OtherSectionNode<>nil then begin
1351       // there is a type/const section in front
1352       // => put the var section below
1353       //debugln(['TCodeCompletionCodeTool.AddLocalVariable start a new var section below '+OtherSectionNode.DescAsString]);
1354       InsertPos:=OtherSectionNode.EndPos;
1355       Indent:=Beauty.GetLineIndent(Src,OtherSectionNode.StartPos);
1356     end else begin
1357       // there is no var/type/const section in front
1358       if (ParentNode.Desc=ctnProcedure) and (HeaderNode=nil) then
1359         HeaderNode:=ParentNode.FirstChild;
1360       if (HeaderNode=nil) then
1361         HeaderNode:=FindUsesNode(ParentNode);
1362 
1363       if CursorNode.Desc in [ctnBeginBlock,ctnAsmBlock] then begin
1364         // add the var section directly in front of the begin
1365         //debugln(['TCodeCompletionCodeTool.AddLocalVariable start a new var section in front of begin block']);
1366         InsertPos:=CursorNode.StartPos;
1367         Indent:=Beauty.GetLineIndent(Src,InsertPos);
1368       end else if HeaderNode<>nil then begin
1369         // put the var section below the header
1370         //debugln(['TCodeCompletionCodeTool.AddLocalVariable start a new var section below '+HeaderNode.DescAsString]);
1371         InsertPos:=HeaderNode.EndPos;
1372         Indent:=Beauty.GetLineIndent(Src,InsertPos);
1373       end else begin
1374         // insert behind section keyword
1375         //debugln(['TCodeCompletionCodeTool.AddLocalVariable start a new var section at start of '+ParentNode.DescAsString]);
1376         MoveCursorToNodeStart(ParentNode);
1377         ReadNextAtom;
1378         InsertPos:=CurPos.EndPos;
1379         Indent:=Beauty.GetLineIndent(Src,InsertPos);
1380       end;
1381     end;
1382     InsertTxt:='var'+Beauty.LineEnd
1383                +Beauty.GetIndentStr(Indent+Beauty.Indent)+InsertTxt;
1384   end;
1385 
1386   // insert new code
1387   InsertTxt:=Beauty.BeautifyStatement(InsertTxt,Indent);
1388   //DebugLn('TCodeCompletionCodeTool.AddLocalVariable E ',InsertTxt,' ');
1389   if InsertAsNewLine then
1390     SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,InsertTxt)
1391   else
1392     SourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,InsertTxt);
1393 
1394   if (VariableTypeUnitName<>'')
1395   and (not IsHiddenUsedUnit(PChar(VariableTypeUnitName))) then begin
1396     if not AddUnitToMainUsesSection(VariableTypeUnitName,'',SourceChangeCache)
1397     then begin
1398       debugln(['TCodeCompletionCodeTool.AddLocalVariable AddUnitToMainUsesSection failed']);
1399       exit;
1400     end;
1401   end;
1402   if not SourceChangeCache.Apply then begin
1403     debugln(['TCodeCompletionCodeTool.AddLocalVariable SourceChangeCache.Apply failed']);
1404     exit;
1405   end;
1406 
1407   // adjust cursor position
1408   AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
1409 
1410   Result:=true;
1411 end;
1412 
1413 procedure TCodeCompletionCodeTool.AdjustCursor(OldCodePos: TCodePosition;
1414   OldTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine: integer);
1415 begin
1416   OldCodePos.Code.AdjustPosition(OldCodePos.P);
1417   NewPos.Code:=OldCodePos.Code;
1418   OldCodePos.Code.AbsoluteToLineCol(OldCodePos.P,NewPos.Y,NewPos.X);
1419   NewTopLine:=NewPos.Y-VisibleEditorLines+1;
1420   if NewTopLine<1 then NewTopLine:=1;
1421   if NewTopLine<OldTopLine then
1422     NewTopLine:=OldTopLine;
1423   //DebugLn('TCodeCompletionCodeTool.AdjustCursor END NewPos: Line=',NewPos.Y,' Col=',NewPos.X,' NewTopLine=',NewTopLine);
1424 end;
1425 
1426 procedure TCodeCompletionCodeTool.AddNeededUnitToMainUsesSection(
1427   AnUnitName: PChar);
1428 var
1429   s: String;
1430 begin
1431   if GetIdentLen(AnUnitName)=0 then exit;
1432   if CompareIdentifiers(AnUnitName,'System')=0 then exit;
1433   if (CompareIdentifiers(AnUnitName,'ObjPas')=0)
1434   and (Scanner.CompilerMode in [cmDELPHI,cmOBJFPC])
1435   and (Scanner.PascalCompiler=pcFPC) then
1436     exit;
1437   if (CompareIdentifiers(AnUnitName,'MacPas')=0)
1438   and (Scanner.CompilerMode=cmMacPas)
1439   and (Scanner.PascalCompiler=pcFPC) then
1440     exit;
1441 
1442   if fNewMainUsesSectionUnits=nil then
1443     fNewMainUsesSectionUnits:=TAVLTree.Create(TListSortCompare(@CompareDottedIdentifiers));
1444   //DebugLn(['TCodeCompletionCodeTool.AddNeededUnitToMainUsesSection AnUnitName="',AnUnitName,'"']);
1445   if fNewMainUsesSectionUnits.Find(AnUnitName)<>nil then exit;
1446   s:=StrPas(AnUnitName);
1447   fNewMainUsesSectionUnits.Add(Pointer(s));
1448   Pointer(s):=nil;
1449 end;
1450 
AddMethodCompatibleToProcTypenull1451 function TCodeCompletionCodeTool.AddMethodCompatibleToProcType(
1452   AClassNode: TCodeTreeNode; const AnEventName: string;
1453   ProcContext: TFindContext; out MethodDefinition: string; out
1454   MethodAttr: TProcHeadAttributes; SourceChangeCache: TSourceChangeCache;
1455   Interactive: Boolean): Boolean;
1456 var
1457   CleanMethodDefinition: string;
1458   Beauty: TBeautifyCodeOptions;
1459   CCOptions: TCodeCreationDlgResult;
1460 begin
1461   Result := False;
1462   MethodDefinition:='';
1463   MethodAttr:=[];
1464 
1465   {$IFDEF CTDEBUG}
1466   DebugLn('  CompleteEventAssignment: Extract method param list...');
1467   {$ENDIF}
1468   // extract method param list and result type
1469   CleanMethodDefinition:=UpperCaseStr(AnEventName)
1470                 +ProcContext.Tool.ExtractProcHead(ProcContext.Node,
1471                      [phpWithoutClassName, phpWithoutName, phpInUpperCase]);
1472 
1473   {$IFDEF CTDEBUG}
1474   DebugLn('  CompleteEventAssignment: Initializing CodeCompletion...');
1475   {$ENDIF}
1476   // initialize class for code completion
1477   CodeCompleteClassNode:=AClassNode;
1478   CodeCompleteSrcChgCache:=SourceChangeCache;
1479 
1480   // insert new published method to class
1481   Beauty:=SourceChangeCache.BeautifyCodeOptions;
1482   MethodAttr:=[phpWithStart, phpWithoutClassKeyword, phpWithVarModifiers,
1483                phpWithParameterNames,phpWithDefaultValues,phpWithResultType];
1484   MethodDefinition:=TrimCodeSpace(ProcContext.Tool.ExtractProcHead(
1485                        ProcContext.Node,
1486                        MethodAttr+[phpWithoutClassName,phpWithoutName]));
1487   MethodDefinition:=Beauty.AddClassAndNameToProc(MethodDefinition, '', AnEventName);
1488   {$IFDEF CTDEBUG}
1489   DebugLn('  CompleteEventAssignment: Add Method To Class...');
1490   {$ENDIF}
1491   if not ProcExistsInCodeCompleteClass(CleanMethodDefinition) then begin
1492     // insert method definition into class
1493     if Interactive then
1494     begin
1495       if not ShowCodeCreationDlg(Beauty.BeautifyProc(MethodDefinition, 0, False), True, CCOptions) then
1496         Exit;
1497     end else
1498       CCOptions.ClassSection := Beauty.MethodDefaultSection;
1499 
1500     AddClassInsertion(CleanMethodDefinition, MethodDefinition,
1501                       AnEventName, InsertClassSectionToNewProcClassPart[CCOptions.ClassSection]);
1502   end;
1503   MethodDefinition:=Beauty.AddClassAndNameToProc(MethodDefinition,
1504                    ExtractClassName(AClassNode,false,true), AnEventName);
1505   if not InsertAllNewClassParts then
1506     RaiseException(20170421201451,ctsErrorDuringInsertingNewClassParts);
1507 
1508   // insert all missing proc bodies
1509   if not CreateMissingClassProcBodies(false) then
1510     RaiseException(20170421201453,ctsErrorDuringCreationOfNewProcBodies);
1511   Result := True;
1512 end;
1513 
1514 procedure TCodeCompletionCodeTool.AddProcedureCompatibleToProcType(
1515   const NewProcName: string; ProcContext: TFindContext; out
1516   MethodDefinition: string; out MethodAttr: TProcHeadAttributes;
1517   SourceChangeCache: TSourceChangeCache; CursorNode: TCodeTreeNode);
1518 var
1519   StartNode: TCodeTreeNode;
1520   Node: TCodeTreeNode;
1521   InFrontOfNode: TCodeTreeNode;
1522   Indent: Integer;
1523   InsertPos: Integer;
1524   NewProc: String;
1525   Beauty: TBeautifyCodeOptions;
1526 begin
1527   Beauty:=SourceChangeCache.BeautifyCodeOptions;
1528   // find a nice insert position in front of methods and CursorNode
1529   StartNode:=FindImplementationNode;
1530   if (StartNode=nil) and (Tree.Root.Desc<>ctnUnit) then
1531     StartNode:=Tree.Root;
1532   InFrontOfNode:=nil;
1533   if StartNode<>nil then begin
1534     Node:=StartNode.FirstChild;
1535     while Node<>nil do begin
1536       if (CursorNode<>nil) and (Node.StartPos>CursorNode.StartPos) then break;
1537       if Node.Desc<>ctnUsesSection then
1538         InFrontOfNode:=Node;
1539       if NodeIsMethodBody(Node)
1540       or (Node.Desc in [ctnBeginBlock,ctnAsmBlock]) then
1541         break;
1542       Node:=Node.NextBrother;
1543     end;
1544   end;
1545   if InFrontOfNode<>nil then begin
1546     // insert in front
1547     Indent:=Beauty.GetLineIndent(Src,InFrontOfNode.StartPos);
1548     InsertPos:=FindLineEndOrCodeInFrontOfPosition(InFrontOfNode.StartPos);
1549   end else begin
1550     Node:=FindMainUsesNode(false);
1551     if Node<>nil then begin
1552       // insert behind uses section
1553       Indent:=Beauty.GetLineIndent(Src,Node.StartPos);
1554       InsertPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
1555     end else begin
1556       // insert at start
1557       if StartNode=nil then begin
1558         // unit without implementation
1559         RaiseException(20170421201459,'need implementation section to insert new procedure');
1560       end;
1561       Node:=StartNode.Next;
1562       if Node<>nil then begin
1563         // insert in front of second node
1564         InsertPos:=Node.StartPos;
1565         Indent:=Beauty.GetLineIndent(Src,InsertPos);
1566       end else if StartNode.Desc=ctnImplementation then begin
1567         // empty implementation => insert at start
1568         Indent:=Beauty.GetLineIndent(Src,StartNode.StartPos);
1569         InsertPos:=StartNode.StartPos+length('implementation');
1570       end else begin
1571         // empty program
1572         RaiseException(20170421201504,'no insert place found for the new procedure');
1573       end;
1574     end;
1575   end;
1576 
1577   // extract method param list, result type and modifiers
1578   MethodAttr:=[phpWithStart, phpWithoutClassKeyword, phpWithVarModifiers,
1579                phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
1580                phpWithCallingSpecs];
1581   MethodDefinition:=TrimCodeSpace(
1582                 ProcContext.Tool.ExtractProcHead(ProcContext.Node,
1583                               MethodAttr+[phpWithoutClassName,phpWithoutName]));
1584   if MethodDefinition='' then
1585     RaiseException(20170422200434,'unknown proctype '+ProcContext.Node.DescAsString);
1586   MethodDefinition:=Beauty.AddClassAndNameToProc(MethodDefinition, '', NewProcName);
1587   debugln(['TCodeCompletionCodeTool.AddProcedureCompatibleToProcType MethodDefinition="',MethodDefinition,'"']);
1588 
1589   // create code and insert
1590   NewProc:=Beauty.BeautifyProc(MethodDefinition,Indent,true);
1591   debugln(['TCodeCompletionCodeTool.AddProcedureCompatibleToProcType NewProc="',NewProc,'"']);
1592   if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,NewProc)
1593   then
1594     RaiseException(20170421201508,'unable to insert code at '+CleanPosToStr(InsertPos,true));
1595 end;
1596 
1597 procedure TCodeCompletionCodeTool.AddNeededUnitsToMainUsesSectionForRange(
1598   StartPos, EndPos: integer; CompletionTool: TCodeCompletionCodeTool);
1599 var
1600   Params: TFindDeclarationParams;
1601   OldCursor: TAtomPosition;
1602   ContextNode: TCodeTreeNode;
1603   NewUnitName: String;
1604 begin
1605   Params:=nil;
1606   ContextNode:=nil;
1607   try
1608     MoveCursorToCleanPos(StartPos);
1609     repeat
1610       ReadNextAtom;
1611       if (CurPos.StartPos>EndPos) or (CurPos.Flag=cafNone) then exit;
1612       if AtomIsIdentifier then begin
1613         //DebugLn(['AddNeededUnitsForRange ',GetAtom]);
1614         // save cursor
1615         OldCursor:=CurPos;
1616         // search identifier
1617         if ContextNode=nil then
1618           ContextNode:=FindDeepestNodeAtPos(CurPos.StartPos,true);
1619         if Params=nil then
1620           Params:=TFindDeclarationParams.Create(Self, ContextNode);
1621         ContextNode := ContextNode.GetNodeOfType(ctnProcedureType);
1622         Params.ContextNode:=ContextNode;
1623         Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier);
1624         Params.Flags:=fdfDefaultForExpressions+[fdfExceptionOnPredefinedIdent];
1625         try
1626           //DebugLn(['TCodeCompletionCodeTool.AddNeededUnitsToMainUsesSectionForRange Identifier=',GetAtom]);
1627           FindIdentifierInContext(Params);
1628           // identifier found
1629           NewUnitName:=Params.NewCodeTool.GetSourceName(false);
1630           //DebugLn(['TCodeCompletionCodeTool.AddNeededUnitsToMainUsesSectionForRange NewUnitName=',NewUnitName]);
1631           if NewUnitName<>'' then
1632             CompletionTool.AddNeededUnitToMainUsesSection(PChar(NewUnitName));
1633         except
1634           on E: ECodeToolError do;
1635         end;
1636         // restore cursor
1637         MoveCursorToAtomPos(OldCursor);
1638       end;
1639     until false;
1640   finally
1641     Params.Free;
1642   end;
1643 end;
1644 
1645 procedure TCodeCompletionCodeTool.CalcMemSize(Stats: TCTMemStats);
1646 begin
1647   inherited CalcMemSize(Stats);
1648   Stats.Add('TCodeCompletionCodeTool',
1649      MemSizeString(FSetPropertyVariablename)
1650     +PtrUInt(SizeOf(FSetPropertyVariableIsPrefix))
1651     +PtrUInt(SizeOf(FSetPropertyVariableUseConst))
1652     +MemSizeString(FJumpToProcHead.Name)
1653     +MemSizeString(FJumpToProcHead.ResultType)
1654     +PtrUInt(SizeOf(FJumpToProcHead.Group))
1655     +length(NewClassSectionIndent)*SizeOf(integer)
1656     +length(NewClassSectionInsertPos)*SizeOf(integer)
1657     +MemSizeString(fFullTopLvlName));
1658  if fNewMainUsesSectionUnits<>nil then
1659    Stats.Add('TCodeCompletionCodeTool.fNewMainUsesSectionUnits',
1660      SizeOf(TAVLTreeNode)*fNewMainUsesSectionUnits.Count);
1661 end;
1662 
TCodeCompletionCodeTool.CompleteClassnull1663 function TCodeCompletionCodeTool.CompleteClass(AClassNode: TCodeTreeNode;
1664   CleanCursorPos, OldTopLine: integer; CursorNode: TCodeTreeNode;
1665   var NewPos: TCodeXYPosition; var NewTopLine, BlockTopLine,
1666   BlockBottomLine: integer): boolean;
1667 var
1668   SectionNode: TCodeTreeNode;
1669   ANode: TCodeTreeNode;
1670 begin
1671   Result:=true;
1672   {$IFDEF CTDEBUG}
1673   DebugLn('TCodeCompletionCodeTool.CompleteCode In-a-class ',NodeDescriptionAsString(AClassNode.Desc));
1674   {$ENDIF}
1675   // cursor is in class/object definition
1676   if (AClassNode.SubDesc and ctnsForwardDeclaration)>0 then exit;
1677   CheckWholeUnitParsed(AClassNode,CursorNode);
1678   // parse class and build CodeTreeNodes for all properties/methods
1679   {$IFDEF CTDEBUG}
1680   DebugLn('TCodeCompletionCodeTool.CompleteCode C ',dbgs(CleanCursorPos),', |',copy(Src,CleanCursorPos,8));
1681   {$ENDIF}
1682   CodeCompleteClassNode:=AClassNode;
1683   try
1684     // go through all properties and procs
1685     //  insert read + write prop specifiers
1686     //  demand Variables + Procs + Proc Bodies
1687     {$IFDEF CTDEBUG}
1688     DebugLn('TCodeCompletionCodeTool.CompleteCode Complete Properties ... ');
1689     {$ENDIF}
1690     if CodeCompleteClassNode.Desc in AllClassObjects then
1691       SectionNode:=CodeCompleteClassNode.FirstChild
1692     else
1693       SectionNode:=CodeCompleteClassNode;
1694     while SectionNode<>nil do begin
1695       ANode:=SectionNode.FirstChild;
1696       while ANode<>nil do begin
1697         if ANode.Desc=ctnProperty then begin
1698           // check if property is complete
1699           if not CompleteProperty(ANode) then
1700             RaiseException(20170421201511,ctsUnableToCompleteProperty);
1701         end;
1702         ANode:=ANode.NextBrother;
1703       end;
1704       if SectionNode=CodeCompleteClassNode then break;
1705       SectionNode:=SectionNode.NextBrother;
1706     end;
1707 
1708     {$IFDEF CTDEBUG}
1709     DebugLn('TCodeCompletionCodeTool.CompleteCode Apply ... ');
1710     {$ENDIF}
1711     // apply the changes and jump to first new proc body
1712     Result:=ApplyChangesAndJumpToFirstNewProc(CleanCursorPos,OldTopLine,true,
1713                                               NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
1714   finally
1715     FreeClassInsertionList;
1716   end;
1717 end;
1718 
TCodeCompletionCodeTool.CompleteForwardProcsnull1719 function TCodeCompletionCodeTool.CompleteForwardProcs(
1720   CursorPos: TCodeXYPosition; ProcNode, CursorNode: TCodeTreeNode;
1721   var NewPos: TCodeXYPosition; var NewTopLine, BlockTopLine,
1722   BlockBottomLine: integer; SourceChangeCache: TSourceChangeCache): boolean;
1723 // add proc bodies for forward procs
1724 // or update signatures
1725 const
1726   ProcAttrDefToBody = [phpWithStart,
1727                phpWithVarModifiers,
1728                phpWithParameterNames,phpWithResultType,phpWithCallingSpecs];
1729 var
1730   RevertableJump: boolean;
1731   ProcDefNodes, ProcBodyNodes: TAVLTree;
1732   StartProcNode: TCodeTreeNode;
1733   CurProcNode: TCodeTreeNode;
1734   EndProcNode: TCodeTreeNode;
1735   ProcCode: String;
1736   Indent: integer;
1737   InsertPos: integer;
1738   Beauty: TBeautifyCodeOptions;
1739   NodeExt: TCodeTreeNodeExtension;
1740   ProcsCopied: boolean;
1741   StartNode: TCodeTreeNode;
1742   OnlyNode: TCodeTreeNode;
1743 begin
1744   Result:=true;
1745   {$IFDEF CTDEBUG}
1746   DebugLn('TCodeCompletionCodeTool.CompleteCode in a forward procedure ... ');
1747   {$ENDIF}
1748   CheckWholeUnitParsed(CursorNode,ProcNode);
1749 
1750   Beauty:=SourceChangeCache.BeautifyCodeOptions;
1751 
1752   ProcDefNodes:=nil;
1753   ProcBodyNodes:=nil;
1754   try
1755     // gather all proc definitions
1756     StartNode:=nil;
1757     if (ProcNode.Parent.Desc=ctnImplementation) then begin
1758       StartNode:=FindInterfaceNode;
1759       if StartNode<>nil then
1760         StartNode:=StartNode.FirstChild;
1761     end;
1762     if StartNode=nil then
1763       StartNode:=FindFirstNodeOnSameLvl(ProcNode);
1764     //debugln(['TCodeCompletionCodeTool.CompleteForwardProcs StartNode=',StartNode.DescAsString,' at ',CleanPosToStr(StartNode.StartPos),'=',ExtractProcName(StartNode,[])]);
1765     ProcDefNodes:=GatherProcNodes(StartNode,
1766                         [phpInUpperCase,phpIgnoreProcsWithBody,phpIgnoreMethods],'');
1767     // gather all proc bodies
1768     ProcBodyNodes:=GatherProcNodes(FindNextNodeOnSameLvl(ProcNode),
1769                         [phpInUpperCase,phpIgnoreForwards,phpIgnoreMethods],'');
1770     //debugln(['TCodeCompletionCodeTool.CompleteForwardProcs Defs=',ProcDefNodes.Count,' Bodies=',ProcBodyNodes.Count]);
1771 
1772     // create mapping from proc defs to proc bodies
1773     GuessProcDefBodyMapping(ProcDefNodes,ProcBodyNodes,true,false);
1774     ProcCode:=ExtractProcHead(ProcNode,[phpInUpperCase]);
1775     NodeExt:=FindNodeExtInTree(ProcDefNodes,ProcCode);
1776     if (NodeExt<>nil) and (NodeExt.Data<>nil) then begin
1777       // proc has already a body => update signatures
1778       //debugln(['TCodeCompletionCodeTool.CompleteForwardProcs proc body already exists, updating signatures ...']);
1779       if Beauty.UpdateMultiProcSignatures then
1780         OnlyNode:=nil
1781       else
1782         OnlyNode:=ProcNode;
1783       if not UpdateProcBodySignatures(ProcDefNodes,ProcBodyNodes,
1784                               ProcAttrDefToBody,ProcsCopied,OnlyNode) then exit;
1785       if not SourceChangeCache.Apply then
1786         RaiseException(20170421201515,'CompleteForwardProcs: unable to apply changes');
1787       exit;
1788     end;
1789 
1790     // find first forward proc without body
1791     StartProcNode:=ProcNode;
1792     CurProcNode:=StartProcNode;
1793     repeat
1794       ProcCode:=ExtractProcHead(CurProcNode,[phpInUpperCase]);
1795       if (FindNodeExtInTree(ProcBodyNodes,ProcCode)<>nil)
1796       or (ProcNodeHasSpecifier(CurProcNode,psEXTERNAL)) then begin
1797         // node is already completed
1798         if CurProcNode=ProcNode then begin
1799           // cursor node is already completed -> stop completion
1800           exit;
1801         end;
1802         break;
1803       end;
1804       StartProcNode:=CurProcNode;
1805       CurProcNode:=CurProcNode.PriorBrother;
1806     until (CurProcNode=nil) or (CurProcNode.Desc<>ctnProcedure)
1807     or ((CurProcNode.SubDesc and ctnsForwardDeclaration)=0);
1808 
1809     // find last forward proc without body
1810     EndProcNode:=ProcNode;
1811     CurProcNode:=EndProcNode.NextBrother;
1812     while (CurProcNode<>nil) and (CurProcNode.Desc=ctnProcedure)
1813     and ((CurProcNode.SubDesc and ctnsForwardDeclaration)>0) do begin
1814       ProcCode:=ExtractProcHead(CurProcNode,[phpInUpperCase]);
1815       if (FindNodeExtInTree(ProcBodyNodes,ProcCode)<>nil)
1816       or (ProcNodeHasSpecifier(CurProcNode,psEXTERNAL)) then begin
1817         // node is already completed
1818         break;
1819       end;
1820       EndProcNode:=CurProcNode;
1821       CurProcNode:=CurProcNode.NextBrother;
1822     end;
1823 
1824     // find a nice insert position
1825     FindInsertPositionForForwardProc(SourceChangeCache,StartProcNode,
1826                                      Indent,InsertPos);
1827 
1828     // build nice procs
1829     CurProcNode:=StartProcNode;
1830     repeat
1831       ProcCode:=ExtractProcHead(CurProcNode,[phpWithStart,
1832                   phpWithoutClassKeyword,
1833                   phpWithVarModifiers,phpWithParameterNames,phpWithResultType,
1834                   phpWithCallingSpecs,phpWithAssembler,phpDoNotAddSemicolon]);
1835       if ProcCode='' then
1836         RaiseException(20170421201518,'CompleteForwardProcs: unable to parse forward proc node');
1837       if ProcCode[length(ProcCode)]<>';' then begin
1838         // add missing semicolon
1839         ProcCode:=ProcCode+';';
1840         UndoReadNextAtom;
1841         if not SourceChangeCache.Replace(gtNone,gtNone,
1842           CurPos.EndPos,CurPos.EndPos,';') then
1843             RaiseException(20170421201522,'CompleteForwardProcs: unable to insert semicolon');
1844       end;
1845       ProcCode:=Beauty.BeautifyProc(ProcCode,Indent,true);
1846       if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
1847         InsertPos,InsertPos,ProcCode) then
1848           RaiseException(20170421201525,'CompleteForwardProcs: unable to insert new proc body');
1849       // next
1850       if CurProcNode=EndProcNode then break;
1851       CurProcNode:=FindNextNodeOnSameLvl(CurProcNode);
1852     until false;
1853     if not SourceChangeCache.Apply then
1854       RaiseException(20170421201528,'CompleteForwardProcs: unable to apply changes');
1855 
1856     // reparse code and find jump point into new proc
1857     Result:=FindJumpPoint(CursorPos,NewPos,NewTopLine,BlockTopLine, BlockBottomLine, RevertableJump);
1858   finally
1859     DisposeAVLTree(ProcDefNodes);
1860     DisposeAVLTree(ProcBodyNodes);
1861   end;
1862 end;
1863 
TCodeCompletionCodeTool.CompleteVariableAssignmentnull1864 function TCodeCompletionCodeTool.CompleteVariableAssignment(CleanCursorPos,
1865   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
1866   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
1867   ): boolean;
1868 var
1869   VarNameAtom, AssignmentOperator, TermAtom: TAtomPosition;
1870   NewType: string;
1871   Params: TFindDeclarationParams;
1872   ExprType: TExpressionType;
1873   MissingUnit, NewName: String;
1874   ResExprContext, OrigExprContext: TFindContext;
1875   ProcNode, ClassNode: TCodeTreeNode;
1876   CCOptions: TCodeCreationDlgResult;
1877 begin
1878   Result:=false;
1879 
1880   {$IFDEF VerboseCompleteLocalVarAssign}
1881   DebugLn('  CompleteLocalVariableAssignment: A');
1882   {$ENDIF}
1883   if not ((CursorNode.Desc=ctnBeginBlock)
1884           or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
1885   if CursorNode.Desc=ctnBeginBlock then
1886     BuildSubTreeForBeginBlock(CursorNode);
1887   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
1888 
1889   {$IFDEF VerboseCompleteLocalVarAssign}
1890   DebugLn('  CompleteLocalVariableAssignment: B CheckLocalVarAssignmentSyntax ...');
1891   {$ENDIF}
1892   // check assignment syntax
1893   if not CheckLocalVarAssignmentSyntax(CleanCursorPos,
1894     VarNameAtom,AssignmentOperator,TermAtom)
1895   then begin
1896     {$IFDEF VerboseCompleteLocalVarAssign}
1897     debugln(['TCodeCompletionCodeTool.CompleteLocalVariableAssignment CheckLocalVarAssignmentSyntax=false']);
1898     {$ENDIF}
1899     exit;
1900   end;
1901   {$IFDEF VerboseCompleteLocalVarAssign}
1902   debugln(['TCodeCompletionCodeTool.CompleteLocalVariableAssignment VarNameAtom=',dbgstr(Src,VarNameAtom.StartPos,VarNameAtom.EndPos-VarNameAtom.StartPos),' AssignmentOperator=',dbgstr(Src,AssignmentOperator.StartPos,AssignmentOperator.EndPos-AssignmentOperator.StartPos),' TermAtom=',dbgstr(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos)]);
1903   {$ENDIF}
1904 
1905   // search variable
1906   ActivateGlobalWriteLock;
1907   Params:=TFindDeclarationParams.Create(Self, CursorNode);
1908   try
1909     {$IFDEF VerboseCompleteLocalVarAssign}
1910     DebugLn('  CompleteLocalVariableAssignment: check if variable is already defined ...');
1911     {$ENDIF}
1912     // check if identifier exists
1913     Result:=IdentifierIsDefined(VarNameAtom,CursorNode,Params);
1914     //debugln(['TCodeCompletionCodeTool.CompleteLocalVariableAssignment Identifier=',dbgstr(Src,VarNameAtom.StartPos,VarNameAtom.EndPos-VarNameAtom.StartPos),' exists=',Result]);
1915     if Result then begin
1916       MoveCursorToCleanPos(VarNameAtom.StartPos);
1917       ReadNextAtom;
1918       RaiseExceptionFmt(20170421201531,ctsIdentifierAlreadyDefined,[GetAtom]);
1919     end;
1920 
1921     {$IFDEF VerboseCompleteLocalVarAssign}
1922     DebugLn('  CompleteLocalVariableAssignment: Find type of term ...',
1923     ' Term="',copy(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"');
1924     {$ENDIF}
1925     // find type of term
1926     Params.ContextNode:=CursorNode;
1927     if Beautifier.OverrideStringTypesWithFirstParamType then
1928       Params.Flags:=Params.Flags+[fdfOverrideStringTypesWithFirstParamType];
1929     NewType:=FindTermTypeAsString(TermAtom,Params,ExprType);
1930     if NewType='' then
1931       RaiseException(20170421201534,'CompleteLocalVariableAssignment Internal error: NewType=""');
1932 
1933     // check if there is another NewType in context of CursorNode
1934     if (ExprType.Desc = xtContext) and (ExprType.Context.Tool <> nil) then
1935     begin
1936       Params.SetIdentifier(Self, PChar(NewType), nil);
1937       Params.ContextNode := CursorNode;
1938       Params.Flags := [fdfSearchInAncestors..fdfIgnoreCurContextNode,fdfTypeType,fdfSearchInHelpers];
1939       if FindIdentifierInContext(Params) then
1940       begin
1941         ResExprContext:=Params.NewCodeTool.FindBaseTypeOfNode(
1942           Params,Params.NewNode);
1943         OrigExprContext:=ExprType.Context.Tool.FindBaseTypeOfNode(
1944           Params,ExprType.Context.Node);
1945         if (ResExprContext.Tool <> OrigExprContext.Tool)
1946         and (ResExprContext.Tool.ExtractSourceName <> 'objpas') then // the "source" types are different -> add unit to the type
1947           NewType := ExprType.Context.Tool.ExtractSourceName + '.' + NewType
1948         else
1949         begin // the "source" types are the same -> set ExprType to found Params.New* so that unit adding is avoided (with MissingUnit)
1950           ExprType.Context.Tool:=Params.NewCodeTool;
1951           ExprType.Context.Node:=Params.NewNode;
1952         end;
1953       end;
1954     end;
1955   finally
1956     Params.Free;
1957     DeactivateGlobalWriteLock;
1958   end;
1959 
1960   MissingUnit:='';
1961   if (ExprType.Desc=xtContext)
1962   and (ExprType.Context.Tool<>nil) then
1963     MissingUnit:=GetUnitNameForUsesSection(ExprType.Context.Tool);
1964 
1965   NewName := GetAtom(VarNameAtom);
1966   FindProcAndClassNode(CursorNode, ProcNode, ClassNode);
1967   if Interactive and (ClassNode<>nil) then
1968   begin
1969     Result:=True;
1970     if not ShowCodeCreationDlg(NewName+': '+NewType+';', False, CCOptions) then
1971       Exit;
1972   end else
1973     CCOptions.Location := cclLocal;
1974 
1975   if CCOptions.Location=cclLocal then
1976     Result:=AddLocalVariable(CleanCursorPos,OldTopLine,NewName,
1977                         NewType,MissingUnit,NewPos,NewTopLine,SourceChangeCache)
1978   else
1979   begin
1980     // initialize class for code completion
1981     CodeCompleteClassNode:=ClassNode;
1982     CodeCompleteSrcChgCache:=SourceChangeCache;
1983     AddClassInsertion(UpperCase(NewName)+';', NewName+':'+NewType+';',
1984       NewName, InsertClassSectionToNewVarClassPart[CCOptions.ClassSection]);
1985     if not InsertAllNewClassParts then
1986       RaiseException(20170421201536,ctsErrorDuringInsertingNewClassParts);
1987     // apply the changes
1988     if not SourceChangeCache.Apply then
1989       RaiseException(20170421201538,ctsUnableToApplyChanges);
1990   end;
1991 end;
1992 
TCodeCompletionCodeTool.CompleteEventAssignmentnull1993 function TCodeCompletionCodeTool.CompleteEventAssignment(CleanCursorPos,
1994   OldTopLine: integer; CursorNode: TCodeTreeNode; out
1995   IsEventAssignment: boolean; var NewPos: TCodeXYPosition;
1996   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache;
1997   Interactive: Boolean): boolean;
1998 { examples:
1999     Button1.OnClick:=|
2000     OnClick:=@AnEve|nt
2001     with Button1 do OnMouseDown:=@|
2002 
2003   If OnClick is a method then it will be completed to
2004     Button1.OnClick:=@Button1Click;
2005   and a 'procedure Button1Click(Sender: TObject);' with a method body will
2006   be added to the published section of the class of the Begin..End Block.
2007 }
2008 
CheckEventAssignmentSyntaxnull2009   function CheckEventAssignmentSyntax(out PropVarAtom: TAtomPosition;
2010     out AssignmentOperator, AddrOperatorPos: integer;
2011     out UserEventAtom: TAtomPosition;
2012     out SemicolonPos: integer): boolean;
2013   begin
2014     Result:=false;
2015 
2016     // check if in begin..end block
2017     if not ((CursorNode.Desc=ctnBeginBlock)
2018             or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
2019     // read event name (optional)
2020 
2021     while (CleanCursorPos<SrcLen)
2022     and (Src[CleanCursorPos] in [':','=',' ',#9]) do
2023       inc(CleanCursorPos);
2024     GetIdentStartEndAtPosition(Src,CleanCursorPos,
2025                                UserEventAtom.StartPos,UserEventAtom.EndPos);
2026     MoveCursorToAtomPos(UserEventAtom);
2027     if AtomIsKeyWord then exit;
2028     ReadPriorAtom;
2029     // check @ operator (optional)
2030     if AtomIsChar('@') then begin
2031       AddrOperatorPos:=CurPos.StartPos;
2032       ReadPriorAtom;
2033     end else
2034       AddrOperatorPos:=-1;
2035     // check assignment operator :=
2036     if not AtomIs(':=') then exit;
2037     AssignmentOperator:=CurPos.StartPos;
2038     ReadPriorAtom;
2039     // check event name
2040     if not AtomIsIdentifier then exit;
2041     PropVarAtom:=CurPos;
2042 
2043     // check for semicolon at end of statement
2044     MoveCursorToCleanPos(UserEventAtom.EndPos);
2045     ReadNextAtom;
2046     if CurPos.Flag = cafRoundBracketOpen then
2047       if Scanner.CompilerMode <> cmDELPHI then
e.g.null2048         Exit // indeed it is assignment to function, e.g. x:=sin(y);
2049       else begin
2050         ReadNextAtom;
2051         if CurPos.Flag <> cafRoundBracketClose then
2052           Exit; // in Delhi mode empty brackets are allowed after method: OnClick:=FormCreate();
2053         ReadNextAtom;
2054       end;
2055     if AtomIsChar(';') then
2056       SemicolonPos:=CurPos.StartPos
2057     else
2058       SemicolonPos:=-1;
2059 
2060     {$IFDEF CTDEBUG}
2061     DebugLn('  CheckEventAssignmentSyntax: "',copy(Src,PropertyAtom.StartPos,
2062           UserEventAtom.EndPos-PropertyAtom.StartPos),'"');
2063     {$ENDIF}
2064 
2065     Result:=true;
2066   end;
2067 
FindEventTypeAtCursornull2068   function FindEventTypeAtCursor(PropVarAtom: TAtomPosition;
2069     out PropVarContext, ProcContext: TFindContext;
2070     Params: TFindDeclarationParams): boolean;
2071   begin
2072     Result:=false;
2073     // find declaration of property identifier
2074     Params.ContextNode:=CursorNode;
2075     MoveCursorToCleanPos(PropVarAtom.StartPos);
2076     Params.SetIdentifier(Self,@Src[CurPos.StartPos],nil);
2077     fFullTopLvlName:='';
2078     Params.OnTopLvlIdentifierFound:=@OnTopLvlIdentifierFound;
2079     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
2080                    fdfTopLvlResolving,fdfFindVariable];
2081     if (not FindDeclarationOfIdentAtParam(Params)) then begin
2082       {$IFDEF CTDEBUG}
2083       DebugLn('FindEventTypeAtCursor identifier "',GetIdentifier(@Src[CurPos.StartPos]),'" not found');
2084       {$ENDIF}
2085       exit;
2086     end;
2087     if not (Params.NewNode.Desc in [ctnProperty,ctnVarDefinition]) then begin
2088       {$IFDEF CTDEBUG}
2089       DebugLn('FindEventTypeAtCursor not a property/variable');
2090       {$ENDIF}
2091       exit;
2092     end;
2093     PropVarContext:=CreateFindContext(Params);
2094     // identifier is property
2095     // -> check type of property
2096     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers];
2097     ProcContext:=PropVarContext.Tool.FindBaseTypeOfNode(
2098                                                     Params,PropVarContext.Node);
2099     if (ProcContext.Node=nil)
2100     or not (ProcContext.Node.Desc in AllProcTypes)
2101     then begin
2102       {$IFDEF CTDEBUG}
2103       DebugLn('FindEventTypeAtCursor not a procedure type');
2104       {$ENDIF}
2105       exit;
2106     end;
2107     // identifier is property/var of type proc => this is an event
2108     Result:=true;
2109   end;
2110 
CreateEventFullNamenull2111   function CreateEventFullName(AClassNode: TCodeTreeNode; UserEventAtom,
2112     PropVarAtom: TAtomPosition): string;
2113   var PropVarName, AClassName: string;
2114     l: integer;
2115   begin
2116     if UserEventAtom.StartPos=UserEventAtom.EndPos then begin
2117       Result:=fFullTopLvlName;
2118       l:=PropVarAtom.EndPos-PropVarAtom.StartPos;
2119       PropVarName:=copy(Src,PropVarAtom.StartPos,l);
2120       if SysUtils.CompareText(PropVarName,RightStr(Result,l))<>0 then
2121         Result:=Result+PropVarName;
2122       if SysUtils.CompareText(PropVarName,Result)=0 then begin
2123         // this is an event of the class (not event of published objects)
2124         // -> add form name
2125         MoveCursorToNodeStart(AClassNode.Parent);
2126         ReadNextAtom;
2127         AClassName:=GetAtom;
2128         if (length(AClassName)>1) and (AClassName[1] in ['t','T']) then
2129           System.Delete(AClassName,1,1);
2130         Result:=AClassName+Result;
2131       end;
2132       // convert OnClick to Click
2133       if (UpperCaseStr(LeftStr(PropVarName,2))='ON')
2134       and (SysUtils.CompareText(RightStr(Result,l),PropVarName)=0)
2135       then
2136         Result:=LeftStr(Result,length(Result)-l)+RightStr(Result,l-2);
2137     end else begin
2138       Result:=copy(Src,UserEventAtom.StartPos,
2139                           UserEventAtom.EndPos-UserEventAtom.StartPos);
2140     end;
2141     {$IFDEF CTDEBUG}
2142     DebugLn('CreateEventFullName "',Result,'"');
2143     {$ENDIF}
2144   end;
2145 
CompleteAssignmentnull2146   function CompleteAssignment(const AnEventName: string;
2147     AssignmentOperator, AddrOperatorPos, SemicolonPos: integer;
2148     UserEventAtom: TAtomPosition): boolean;
2149   var RValue: string;
2150     StartInsertPos, EndInsertPos: integer;
2151   begin
2152     {$IFDEF CTDEBUG}
2153     DebugLn('  CompleteEventAssignment: Changing right side of assignment...');
2154     {$ENDIF}
2155     // add new event name as right value of assignment
2156     // add address operator @ if needed or user provided it himself
2157     RValue:=AnEventName+';';
2158     if (AddrOperatorPos>0)
2159     or ((Scanner.PascalCompiler=pcFPC) and (Scanner.CompilerMode<>cmDelphi))
2160     then
2161       RValue:='@'+RValue;
2162     RValue:=':='+RValue;
2163     RValue:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(RValue,0);
2164     StartInsertPos:=AssignmentOperator;
2165     EndInsertPos:=SemicolonPos+1;
2166     if EndInsertPos<1 then
2167       EndInsertPos:=UserEventAtom.EndPos;
2168     if EndInsertPos<1 then
2169       EndInsertPos:=AddrOperatorPos;
2170     if EndInsertPos<1 then
2171       EndInsertPos:=AssignmentOperator+2;
2172     Result:=SourceChangeCache.Replace(gtNone,gtNewLine,
2173                                       StartInsertPos,EndInsertPos,RValue);
2174   end;
2175 
2176   procedure AddProcedure(Identifier: string;
2177     TypeTool: TFindDeclarationTool; TypeNode: TCodeTreeNode);
2178   var
2179     ProcContext: TFindContext;
2180     AMethodDefinition: string;
2181     AMethodAttr: TProcHeadAttributes;
2182   begin
2183     // create new method
2184     ProcContext:=CreateFindContext(TypeTool,TypeNode);
2185     AddProcedureCompatibleToProcType(Identifier,
2186       ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,
2187       CursorNode);
2188 
2189     // apply the changes
2190     if not SourceChangeCache.Apply then
2191       RaiseException(20170421201540,ctsUnableToApplyChanges);
2192 
2193     {$IFDEF CTDEBUG}
2194     DebugLn('  CompleteEventAssignment.AddProcedure: jumping to new method body...');
2195     {$ENDIF}
2196     // jump to new method body
2197     if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2198     then
2199       RaiseException(20170421201543,'CompleteEventAssignment.AddProcedure JumpToMethod failed');
2200   end;
2201 
CompleteEventAssignmentnull2202 // function CompleteEventAssignment: boolean
2203 var
2204   UserEventAtom, PropVarAtom: TAtomPosition;
2205   AssignmentOperator, AddrOperatorPos, SemicolonPos: integer;
2206   Params: TFindDeclarationParams;
2207   PropertyContext, ProcContext: TFindContext;
2208   FullEventName, AMethodDefinition: string;
2209   AMethodAttr: TProcHeadAttributes;
2210   ProcNode, AClassNode: TCodeTreeNode;
2211   Identifier: String;
2212 begin
2213   IsEventAssignment:=false;
2214   Result:=false;
2215 
2216   {$IFDEF VerboseCompleteEventAssign}
2217   DebugLn('  CompleteEventAssignment: CheckEventAssignmentSyntax...');
2218   {$ENDIF}
2219   // check assigment syntax
2220   if not CheckEventAssignmentSyntax(PropVarAtom, AssignmentOperator,
2221                                    AddrOperatorPos, UserEventAtom, SemicolonPos)
2222   then
2223     exit;
2224   IsEventAssignment:=true;
2225   if OldTopLine=0 then ;
2226 
2227   ProcNode:=nil;
2228   AClassNode:=nil;
2229   CheckWholeUnitParsed(CursorNode,ProcNode);
2230 
2231   if CursorNode.Desc=ctnBeginBlock then
2232     BuildSubTreeForBeginBlock(CursorNode);
2233   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
2234 
2235   {$IFDEF VerboseCompleteEventAssign}
2236   DebugLn('  CompleteEventAssignment: check if a method and find class...');
2237   {$ENDIF}
2238   FindProcAndClassNode(CursorNode,ProcNode,AClassNode);
2239 
2240   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2241   try
2242     {$IFDEF VerboseCompleteEventAssign}
2243     DebugLn('  CompleteEventAssignment: FindEventTypeAtCursor...');
2244     {$ENDIF}
2245     // check if identifier is event property and build
2246     Result:=FindEventTypeAtCursor(PropVarAtom,PropertyContext,ProcContext,
2247                                   Params);
2248     if not Result then exit;
2249 
2250     if ((AClassNode<>nil) and (ProcContext.Node.Desc=ctnReferenceTo))
2251     or ProcContext.Tool.ProcNodeHasOfObject(ProcContext.Node) then begin
2252       if AClassNode<>nil then begin
2253         {$IFDEF VerboseCompleteEventAssign}
2254         DebugLn('  CompleteEventAssignment: CreateEventFullName... UserEventAtom.StartPos=',dbgs(UserEventAtom.StartPos));
2255         {$ENDIF}
2256         // create a nice event name
2257         FullEventName:=CreateEventFullName(AClassNode,UserEventAtom,PropVarAtom);
2258         if FullEventName='' then exit;
2259 
2260         // add published method and method body and right side of assignment
2261         if not AddMethodCompatibleToProcType(AClassNode,FullEventName,ProcContext,
2262           AMethodDefinition,AMethodAttr,SourceChangeCache,Interactive)
2263         then
2264           Exit;
2265         if not CompleteAssignment(FullEventName,AssignmentOperator,
2266           AddrOperatorPos,SemicolonPos,UserEventAtom)
2267         then
2268           RaiseException(20170421201546,'CompleteEventAssignment CompleteAssignment failed');
2269       end else if ProcContext.Tool.ProcNodeHasOfObject(ProcContext.Node) then begin
2270         {$IFDEF VerboseCompleteEventAssign}
2271         debugln(['  CompleteEventAssignment:  proc is "of object"']);
2272         {$ENDIF}
2273         MoveCursorToCleanPos(PropVarAtom.StartPos);
2274         RaiseException(20170421201550,'Complete event failed: procedure of object needs a class');
2275       end;
2276     end else begin
2277       // create procedure (not method)
2278       {$IFDEF VerboseCompleteEventAssign}
2279       debugln(['  CompleteEventAssignment: create a proc name']);
2280       {$ENDIF}
2281       // get name
2282       Identifier:='';
2283       if (UserEventAtom.StartPos>1) and (UserEventAtom.StartPos<=SrcLen) then
2284         Identifier:=GetIdentifier(@Src[UserEventAtom.StartPos]);
2285       if Identifier='' then
2286         Identifier:=GetIdentifier(@Src[PropVarAtom.StartPos]);
2287       if Identifier='' then begin
2288         MoveCursorToCleanPos(PropVarAtom.StartPos);
2289         RaiseException(20170421201553,'Complete event failed: need a name');
2290       end;
2291       // create proc
2292       {$IFDEF VerboseCompleteEventAssign}
2293       debugln(['  CompleteEventAssignment: create a proc name']);
2294       {$ENDIF}
2295       AddProcedureCompatibleToProcType(Identifier,
2296         ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,
2297         CursorNode);
2298     end;
2299   finally
2300     Params.Free;
2301   end;
2302 
2303   {$IFDEF VerboseCompleteEventAssign}
2304   DebugLn('  CompleteEventAssignment: Applying changes...');
2305   {$ENDIF}
2306   // apply the changes
2307   if not SourceChangeCache.Apply then
2308     RaiseException(20170421201555,ctsUnableToApplyChanges);
2309 
2310   {$IFDEF VerboseCompleteEventAssign}
2311   DebugLn('  CompleteEventAssignment: jumping to new method body...');
2312   {$ENDIF}
2313   // jump to new method body
2314   if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2315   then
2316     RaiseException(20170421201558,'CompleteEventAssignment Internal Error 2');
2317 
2318   Result:=true;
2319 end;
2320 
CompleteVariableForInnull2321 function TCodeCompletionCodeTool.CompleteVariableForIn(CleanCursorPos,
2322   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
2323   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
2324   ): boolean;
2325 var
2326   VarNameAtom: TAtomPosition;
2327   TermAtom: TAtomPosition;
2328   Params: TFindDeclarationParams;
2329   NewType: String;
2330   ExprType: TExpressionType;
2331   MissingUnit: String;
2332 begin
2333   Result:=false;
2334 
2335   {$IFDEF CTDEBUG}
2336   DebugLn('  CompleteLocalVariableForIn: A');
2337   {$ENDIF}
2338   if not ((CursorNode.Desc=ctnBeginBlock)
2339           or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
2340   if CursorNode.Desc=ctnBeginBlock then
2341     BuildSubTreeForBeginBlock(CursorNode);
2342   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
2343 
2344   {$IFDEF CTDEBUG}
2345   DebugLn('  CompleteLocalVariableForIn: B CheckLocalVarForInSyntax ...');
2346   {$ENDIF}
2347   // check assignment syntax
2348   if not CheckLocalVarForInSyntax(CleanCursorPos,
2349     VarNameAtom,TermAtom)
2350   then
2351     exit;
2352   DebugLn(['TCodeCompletionCodeTool.CompleteLocalVariableForIn Var=',GetAtom(VarNameAtom),' Term=',GetAtom(TermAtom)]);
2353 
2354   // search variable
2355   ActivateGlobalWriteLock;
2356   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2357   try
2358     {$IFDEF CTDEBUG}
2359     DebugLn('  CompleteLocalVariableForIn: check if variable is already defined ...');
2360     {$ENDIF}
2361     // check if identifier exists
2362     Result:=IdentifierIsDefined(VarNameAtom,CursorNode,Params);
2363     if Result then begin
2364       MoveCursorToCleanPos(VarNameAtom.StartPos);
2365       ReadNextAtom;
2366       RaiseExceptionFmt(20170421201601,ctsIdentifierAlreadyDefined,[GetAtom]);
2367     end;
2368 
2369     {$IFDEF CTDEBUG}
2370     DebugLn('  CompleteLocalVariableForIn: Find type of term ...',
2371     ' Term="',copy(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"');
2372     {$ENDIF}
2373     // find type of term
2374     NewType:=FindForInTypeAsString(TermAtom,CursorNode,Params,ExprType);
2375     if NewType='' then
2376       RaiseException(20170421201604,'CompleteLocalVariableForIn Internal error: NewType=""');
2377 
2378   finally
2379     Params.Free;
2380     DeactivateGlobalWriteLock;
2381   end;
2382 
2383   MissingUnit:='';
2384   if (ExprType.Desc=xtContext)
2385   and (ExprType.Context.Tool<>nil) then
2386     MissingUnit:=GetUnitNameForUsesSection(ExprType.Context.Tool);
2387 
2388   Result:=AddLocalVariable(CleanCursorPos,OldTopLine,GetAtom(VarNameAtom),
2389                       NewType,MissingUnit,NewPos,NewTopLine,SourceChangeCache);
2390 end;
2391 
CompleteIdentifierByParameternull2392 function TCodeCompletionCodeTool.CompleteIdentifierByParameter(CleanCursorPos,
2393   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
2394   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
2395   ): boolean;
2396 
2397   procedure AddMethod(Identifier: string;
2398     TypeTool: TFindDeclarationTool; TypeNode: TCodeTreeNode);
2399   var
2400     AMethodAttr: TProcHeadAttributes;
2401     AMethodDefinition: string;
2402     ProcContext: TFindContext;
2403     AClassNode: TCodeTreeNode;
2404   begin
2405     // parameter needs a method => search class of method
2406     AClassNode:=FindClassOrInterfaceNode(CursorNode,true);
2407     if (AClassNode=nil) then
2408       RaiseException(20170421201607,'parameter needs a method');
2409     ProcContext:=CreateFindContext(TypeTool,TypeNode);
2410 
2411     // create new method
2412     if not AddMethodCompatibleToProcType(AClassNode,Identifier,
2413       ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,Interactive)
2414     then
2415       Exit;
2416 
2417     // apply the changes
2418     if not SourceChangeCache.Apply then
2419       RaiseException(20170421201609,ctsUnableToApplyChanges);
2420 
2421     {$IFDEF CTDEBUG}
2422     DebugLn('  CompleteIdentifierByParameter.AddMethod: jumping to new method body...');
2423     {$ENDIF}
2424     // jump to new method body
2425     if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2426     then
2427       RaiseException(20170421201612,'CompleteIdentifierByParameter.AddMethod JumpToMethod failed');
2428   end;
2429 
2430   procedure AddProcedure(Identifier: string;
2431     TypeTool: TFindDeclarationTool; TypeNode: TCodeTreeNode);
2432   var
2433     ProcContext: TFindContext;
2434     AMethodDefinition: string;
2435     AMethodAttr: TProcHeadAttributes;
2436   begin
2437     // create new method
2438     ProcContext:=CreateFindContext(TypeTool,TypeNode);
2439     AddProcedureCompatibleToProcType(Identifier,
2440       ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,
2441       CursorNode);
2442 
2443     // apply the changes
2444     if not SourceChangeCache.Apply then
2445       RaiseException(20170421201614,ctsUnableToApplyChanges);
2446 
2447     {$IFDEF CTDEBUG}
2448     DebugLn('  CompleteIdentifierByParameter.AddProcedure: jumping to new method body...');
2449     {$ENDIF}
2450     // jump to new method body
2451     if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2452     then
2453       RaiseException(20170421201617,'CompleteIdentifierByParameter.AddProcedure JumpToMethod failed');
2454   end;
2455 
2456 var
2457   VarNameRange, ProcNameAtom: TAtomPosition;
2458   ParameterIndex: integer;
2459   Params: TFindDeclarationParams;
2460   ParameterNode: TCodeTreeNode;
2461   TypeNode: TCodeTreeNode;
2462   NewType: String;
2463   IgnorePos: TCodePosition;
2464   MissingUnitName: String;
2465   ProcStartPos: LongInt;
2466   ExprType: TExpressionType;
2467   Context: TFindContext;
2468   HasAtOperator: Boolean;
2469   TypeTool: TFindDeclarationTool;
2470   AliasType: TFindContext;
2471   Identifier: String;
2472 begin
2473   Result:=false;
2474 
2475   {$IFDEF CTDEBUG}
2476   DebugLn('  CompleteIdentifierByParameter: A');
2477   {$ENDIF}
2478   if not ((CursorNode.Desc=ctnBeginBlock)
2479           or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
2480   if CursorNode.Desc=ctnBeginBlock then
2481     BuildSubTreeForBeginBlock(CursorNode);
2482   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
2483 
2484   {$IFDEF CTDEBUG}
2485   DebugLn('  CompleteIdentifierByParameter: B check if it is a parameter ...');
2486   {$ENDIF}
2487   // check parameter syntax
2488   if not CheckParameterSyntax(CursorNode.StartPos,CleanCursorPos,
2489                               VarNameRange,ProcNameAtom,ParameterIndex)
2490   then
2491     exit;
2492   HasAtOperator:=false;
2493   if (VarNameRange.StartPos<=SrcLen)
2494   and (Src[VarNameRange.StartPos]='@') then begin
2495     HasAtOperator:=true;
2496     MoveCursorToCleanPos(VarNameRange.StartPos+1);
2497     ReadNextAtom;
2498     VarNameRange.StartPos:=CurPos.StartPos;
2499     //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter HasAtOperator ',GetAtom(VarNameRange)]);
2500   end;
2501   Identifier:=ExtractCode(VarNameRange.StartPos,VarNameRange.EndPos,[]);
2502   if not IsValidIdent(Identifier) then exit;
2503 
2504   {$IFDEF CTDEBUG}
2505   DebugLn('  CompleteIdentifierByParameter VarNameAtom=',GetAtom(VarNameAtom),' ProcNameAtom=',GetAtom(ProcNameAtom),' ParameterIndex=',dbgs(ParameterIndex));
2506   {$ENDIF}
2507 
2508   // search variable
2509   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2510   try
2511     {$IFDEF CTDEBUG}
2512     DebugLn('  CompleteIdentifierByParameter: check if variable is already defined ...');
2513     {$ENDIF}
2514     // check if identifier exists
2515     Result:=IdentifierIsDefined(VarNameRange,CursorNode,Params);
2516     if Result then begin
2517       MoveCursorToCleanPos(VarNameRange.StartPos);
2518       ReadNextAtom;
2519       RaiseExceptionFmt(20170421201619,ctsIdentifierAlreadyDefined,[GetAtom]);
2520     end;
2521 
2522     {$IFDEF CTDEBUG}
2523     DebugLn('  CompleteIdentifierByParameter: Find declaration of parameter list ...  procname="',GetAtom(ProcNameAtom),'"');
2524     {$ENDIF}
2525 
2526     Context:=CreateFindContext(Self,CursorNode);
2527     ProcStartPos:=FindStartOfTerm(ProcNameAtom.EndPos,false);
2528     if ProcStartPos<ProcNameAtom.StartPos then begin
2529       // for example: Canvas.Line
2530       // find class
2531       {$IFDEF CTDEBUG}
2532       debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter Call="',ExtractCode(ProcStartPos,ProcNameAtom.EndPos,[]),'"']);
2533       {$ENDIF}
2534       Params.ContextNode:=Context.Node;
2535       Params.Flags:=fdfDefaultForExpressions+[fdfFunctionResult,fdfFindChildren];
2536       ExprType:=FindExpressionResultType(Params,ProcStartPos,ProcNameAtom.StartPos);
2537       if not(ExprType.Desc in xtAllIdentTypes) then begin
2538         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter Call="',ExtractCode(ProcStartPos,ProcNameAtom.StartPos,[]),'" gives ',ExprTypeToString(ExprType)]);
2539         exit;
2540       end;
2541       Context:=ExprType.Context;
2542       if Assigned(Context.Tool) and Assigned(Context.Node) then
2543       begin
2544         // resolve point '.'
2545         //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter base class: ',FindContextToString(Context)]);
2546         Params.Clear;
2547         Params.Flags:=fdfDefaultForExpressions;
2548         Context:=Context.Tool.FindBaseTypeOfNode(Params,Context.Node);
2549         {$IFDEF CTDEBUG}
2550         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter search proc in sub context: ',FindContextToString(Context)]);
2551         {$ENDIF}
2552       end;
2553     end;
2554     if Assigned(Context.Tool) and Assigned(Context.Node) then
2555     begin
2556       // find declaration of parameter list
2557       // ToDo: search in all overloads for the best fit
2558       Params.ContextNode:=Context.Node;
2559       Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],nil);
2560       Params.Flags:=fdfDefaultForExpressions+[fdfFindVariable];
2561       if Context.Node=CursorNode then
2562         Params.Flags:=Params.Flags+[fdfSearchInParentNodes,fdfIgnoreCurContextNode]
2563       else
2564         Params.Flags:=Params.Flags-[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
2565       CleanPosToCodePos(VarNameRange.StartPos,IgnorePos);
2566       IgnoreErrorAfter:=IgnorePos;
2567       try
2568         {$IFDEF CTDEBUG}
2569         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter searching ',GetIdentifier(Params.Identifier),' [',dbgs(Params.Flags),'] in ',FindContextToString(Context)]);
2570         {$ENDIF}
2571         if not Context.Tool.FindIdentifierInContext(Params) then exit;
2572       finally
2573         ClearIgnoreErrorAfter;
2574       end;
2575     end else
2576     if (ExprType.Desc in xtAllTypeHelperTypes) then
2577     begin
2578       Params.ContextNode:=CursorNode;
2579       Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],nil);
2580       Params.Flags:=fdfDefaultForExpressions+[fdfFindVariable]+
2581         [fdfSearchInParentNodes,fdfIgnoreCurContextNode];
2582       FindIdentifierInBasicTypeHelpers(ExprType.Desc, Params);
2583     end;
2584 
2585     NewType:='';
2586     MissingUnitName:='';
2587     if Params.NewNode=nil then exit;
2588     //DebugLn('TCodeCompletionCodeTool.CompleteLocalVariableAsParameter Proc/PropNode=',Params.NewNode.DescAsString,' ',copy(Params.NewCodeTool.Src,Params.NewNode.StartPos,50));
2589 
2590     if Params.NewNode.Desc=ctnVarDefinition then
2591     begin
2592       try
2593         ExprType:=Params.NewCodeTool.ConvertNodeToExpressionType(Params.NewNode,Params);
2594         if (ExprType.Desc=xtContext) and (ExprType.Context.Node<>nil) then begin
2595           Params.NewCodeTool:=ExprType.Context.Tool;
2596           Params.NewNode:=ExprType.Context.Node;
2597         end;
2598       except
2599       end;
2600     end;
2601     ParameterNode:=Params.NewCodeTool.FindNthParameterNode(Params.NewNode,
2602                                                            ParameterIndex);
2603     if (ParameterNode=nil)
2604     and (Params.NewNode.Desc in [ctnProperty,ctnProcedure]) then begin
2605       DebugLn(['  CompleteIdentifierByParameter Procedure has less than ',ParameterIndex+1,' parameters']);
2606       exit;
2607     end;
2608     if ParameterNode=nil then exit;
2609     //DebugLn('TCodeCompletionCodeTool.CompleteIdentifierByParameter ParameterNode=',ParameterNode.DescAsString,' ',copy(Params.NewCodeTool.Src,ParameterNode.StartPos,50));
2610     TypeTool:=Params.NewCodeTool;
2611     TypeNode:=FindTypeNodeOfDefinition(ParameterNode);
2612     if TypeNode=nil then begin
2613       DebugLn('  CompleteIdentifierByParameter Parameter has no type');
2614       exit;
2615     end;
2616     // default: copy the type
2617     NewType:=TypeTool.ExtractCode(TypeNode.StartPos,TypeNode.EndPos,[]);
2618 
2619     // search type
2620     Params.Clear;
2621     Params.ContextNode:=TypeNode;
2622     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
2623                    fdfTopLvlResolving];
2624     AliasType:=CleanFindContext;
2625     ExprType:=TypeTool.FindExpressionResultType(Params,
2626                               TypeNode.StartPos,TypeNode.EndPos,@AliasType);
2627     //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter type: AliasType=',FindContextToString(AliasType)]);
2628 
2629     TypeTool:=ExprType.Context.Tool;
2630     TypeNode:=ExprType.Context.Node;
2631     if HasAtOperator
2632     or ((Scanner.CompilerMode=cmDelphi) and (ExprType.Desc=xtContext) // procedures in delphi mode without @
2633         and (TypeNode<>nil) and (TypeNode.Desc in AllProcTypes)) then
2634     begin
2635       debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter HasAtOperator ExprType=',ExprTypeToString(ExprType)]);
2636       NewType:='';
2637       if (ExprType.Desc<>xtContext)
2638       or (TypeNode=nil) then begin
2639         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter has @ operator, but this is not implemented for ',ExprTypeToString(ExprType)]);
2640         exit;
2641       end;
2642       if (TypeNode.Desc=ctnPointerType) then begin
2643         // for example PMapID = ^...
2644         if (TypeNode.FirstChild<>nil)
2645         and (TypeNode.FirstChild.Desc=ctnIdentifier) then begin
2646           // for example PMapID = ^TMapID
2647           NewType:=TypeTool.ExtractCode(TypeNode.FirstChild.StartPos,
2648                                         TypeNode.FirstChild.EndPos,[]);
2649           //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter pointer to ',NewType]);
2650           Params.Clear;
2651           Params.ContextNode:=TypeNode;
2652           Params.Flags:=fdfDefaultForExpressions;
2653           AliasType:=CleanFindContext;
2654           ExprType:=TypeTool.FindExpressionResultType(Params,
2655             TypeNode.FirstChild.StartPos,TypeNode.FirstChild.EndPos,
2656             @AliasType);
2657           //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter is pointer to type: AliasType=',FindContextToString(AliasType)]);
2658         end;
2659       end else if TypeNode.Desc in AllProcTypes then begin
2660         // for example TNotifyEvent = procedure(...
2661         if TypeTool.ProcNodeHasOfObject(TypeNode) then begin
2662           AddMethod(Identifier,TypeTool,TypeNode);
2663         end else begin
2664           // parameter needs a procedure
2665           AddProcedure(Identifier,TypeTool,TypeNode);
2666         end;
2667         exit(true);
2668       end;
2669       if NewType='' then begin
2670         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter has @ operator, but this is not implemented for ',ExprTypeToString(ExprType)]);
2671         exit;
2672       end;
2673     end;
2674     if AliasType.Node<>nil then begin
2675       // an identifier
2676       MissingUnitName:=GetUnitNameForUsesSection(AliasType.Tool);
2677       //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter MissingUnitName=',MissingUnitName]);
2678     end;
2679 
2680     //DebugLn('TCodeCompletionCodeTool.CompleteIdentifierByParameter NewType=',NewType);
2681     if NewType='' then
2682       RaiseException(20170421201622,'CompleteIdentifierByParameter Internal error: NewType=""');
2683     //DebugLn('  CompleteIdentifierByParameter Dont know: ',Params.NewNode.DescAsString);
2684 
2685   finally
2686     Params.Free;
2687   end;
2688 
2689   Result:=AddLocalVariable(CleanCursorPos,OldTopLine,GetAtom(VarNameRange),
2690                    NewType,MissingUnitName,NewPos,NewTopLine,SourceChangeCache);
2691 end;
2692 
TCodeCompletionCodeTool.CompleteMethodByBodynull2693 function TCodeCompletionCodeTool.CompleteMethodByBody(
2694   CleanCursorPos, OldTopLine: integer;
2695   CursorNode: TCodeTreeNode;
2696   var NewPos: TCodeXYPosition; var NewTopLine: integer;
2697   SourceChangeCache: TSourceChangeCache): boolean;
2698 const
2699   ProcAttrCopyBodyToDef = [phpWithStart,phpWithoutClassName,phpWithVarModifiers,
2700     phpWithParameterNames,phpWithDefaultValues,phpWithResultType];
2701 
2702   procedure MergeProcModifiers(DefProcNode, BodyProcNode: TCodeTreeNode;
2703     var ProcCode: String);
2704   var
2705     FirstBodyModAtom: TAtomPosition;
2706     BodyHeadEnd: Integer;
2707     DefHeadEnd: Integer;
2708     Modifier: shortstring;
2709     OldCursor: TAtomPosition;
2710     AddModifier: boolean;
2711   begin
2712     MoveCursorToFirstProcSpecifier(DefProcNode);
2713     if DefProcNode.FirstChild<>nil then
2714       DefHeadEnd:=DefProcNode.FirstChild.EndPos
2715     else
2716       DefHeadEnd:=DefProcNode.EndPos;
2717     FirstBodyModAtom:=CleanAtomPosition;
2718     BodyHeadEnd:=0;
2719     while CurPos.EndPos<DefHeadEnd do begin
2720       if CurPos.Flag<>cafSemicolon then begin
2721         // a modifier of the definition
2722         Modifier:=copy(GetAtom,1,255);
2723         //debugln(['MergeProcModifiers body modifier: ',Modifier]);
2724         if not IsKeyWordCallingConvention.DoItCaseInsensitive(Modifier) then
2725         begin
2726           // test if body already has this modifier
2727           OldCursor:=CurPos;
2728           if BodyHeadEnd=0 then begin
2729             MoveCursorToFirstProcSpecifier(BodyProcNode);
2730             FirstBodyModAtom:=CurPos;
2731             if BodyProcNode.FirstChild<>nil then
2732               BodyHeadEnd:=BodyProcNode.FirstChild.EndPos
2733             else
2734               BodyHeadEnd:=BodyProcNode.EndPos;
2735           end else
2736             MoveCursorToAtomPos(FirstBodyModAtom);
2737           while CurPos.EndPos<BodyHeadEnd do begin
2738             if CurPos.Flag<>cafSemicolon then begin
2739               if AtomIs(Modifier) then break;
2740               // skip to next modifier of body
2741               repeat
2742                 ReadNextAtom;
2743               until (CurPos.Flag=cafSemicolon) or (CurPos.EndPos>=BodyHeadEnd);
2744             end else
2745               ReadNextAtom;
2746           end;
2747           AddModifier:=CurPos.EndPos>=BodyHeadEnd;
2748           MoveCursorToAtomPos(OldCursor);
2749         end else
2750           AddModifier:=false;
2751         // skip to next modifier of definition
2752         repeat
2753           if AddModifier then begin
2754             if (IsIdentStartChar[Src[CurPos.StartPos]]
2755             and IsIdentChar[ProcCode[length(ProcCode)]]) // space needed between words
2756             or IsSpaceChar[Src[CurPos.StartPos-1]] // copy space from body
2757             then
2758               ProcCode:=ProcCode+' ';
2759             ProcCode:=ProcCode+GetAtom;
2760           end;
2761           ReadNextAtom;
2762         until (CurPos.Flag=cafSemicolon) or (CurPos.EndPos>=DefHeadEnd);
2763         if AddModifier then
2764           ProcCode:=ProcCode+';';
2765       end else
2766         ReadNextAtom;
2767     end;
2768   end;
2769 
2770 var
2771   CurClassName: String;
2772   BodyProcNode: TCodeTreeNode;
2773   CleanProcCode: String;
2774   ProcName: String;
2775   OldCodePos: TCodePosition;
2776   ClassProcs: TAVLTree;
2777   ProcBodyNodes: TAVLTree;
2778   AVLNode: TAVLTreeNode;
2779   NodeExt: TCodeTreeNodeExtension;
2780   DefProcNode: TCodeTreeNode;
2781   NewProcCode: String;
2782   OldProcCode: String;
2783   FromPos: Integer;
2784   EndPos: Integer;
2785   Indent: Integer;
2786   Beauty: TBeautifyCodeOptions;
2787 begin
2788   Result:=false;
2789 
2790   // check if cursor in a method
2791   if CursorNode.Desc=ctnProcedure then
2792     BodyProcNode:=CursorNode
2793   else
2794     BodyProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
2795   if (BodyProcNode=nil) or (BodyProcNode.Desc<>ctnProcedure)
2796   or (not NodeIsMethodBody(BodyProcNode)) then begin
2797     {$IFDEF VerboseCompleteMethod}
2798     DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody node is not a method body ',BodyProcNode<>nil]);
2799     {$ENDIF}
2800     exit;
2801   end;
2802 
2803   CheckWholeUnitParsed(CursorNode,BodyProcNode);
2804 
2805   // find corresponding class declaration
2806   CurClassName:=ExtractClassNameOfProcNode(BodyProcNode);
2807   if CurClassName='' then begin
2808     DebugLn(['CompleteMethodByBody ExtractClassNameOfProcNode failed']);
2809     exit;
2810   end;
2811   //DebugLn(['CompleteMethod CurClassName=',CurClassName]);
2812   CodeCompleteClassNode:=FindClassNodeInUnit(CurClassName,true,false,false,true);
2813 
2814   Beauty:=SourceChangeCache.BeautifyCodeOptions;
2815   ClassProcs:=nil;
2816   ProcBodyNodes:=nil;
2817   try
2818     // find the corresponding node in the class
2819     DefProcNode:=nil;
2820 
2821     // gather existing proc definitions in the class
2822     ClassProcs:=GatherClassProcDefinitions(CodeCompleteClassNode,true);
2823     CleanProcCode:=ExtractProcHead(BodyProcNode,[phpInUpperCase]);
2824     NodeExt:=FindCodeTreeNodeExt(ClassProcs,CleanProcCode);
2825     if NodeExt<>nil then begin
2826       DefProcNode:=TCodeTreeNodeExtension(NodeExt).Node;
2827     end else begin
2828       // the proc was not found by name+params
2829       // => guess
2830       ProcBodyNodes:=GatherClassProcBodies(CodeCompleteClassNode);
2831       GuessProcDefBodyMapping(ClassProcs,ProcBodyNodes,true,true);
2832       AVLNode:=ProcBodyNodes.FindLowest;
2833       NodeExt:=nil;
2834       while AVLNode<>nil do begin
2835         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
2836         if NodeExt.Node=BodyProcNode then begin
2837           if NodeExt.Data<>nil then
2838             DefProcNode:=TCodeTreeNodeExtension(NodeExt.Data).Node;
2839           break;
2840         end;
2841         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
2842       end;
2843     end;
2844 
2845     if DefProcNode<>nil then begin
2846       // update existing definition
2847       {$IFDEF VerboseCompleteMethod}
2848       DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody corresponding definition exists for "',CleanProcCode,'"']);
2849       {$ENDIF}
2850       OldProcCode:=ExtractProcHead(DefProcNode,ProcAttrCopyBodyToDef+[phpWithProcModifiers]);
2851       NewProcCode:=ExtractProcHead(BodyProcNode,ProcAttrCopyBodyToDef+[phpWithCallingSpecs]);
2852       // some modifiers are only allowed in the definition
2853       // => keep the old definition modifiers
2854       MergeProcModifiers(DefProcNode,BodyProcNode,NewProcCode);
2855       if CompareTextIgnoringSpace(NewProcCode,OldProcCode,false)=0 then
2856         exit(true); // already matching
2857       // ToDo: definition needs update
2858       {$IFDEF VerboseCompleteMethod}
2859       debugln(['TCodeCompletionCodeTool.CompleteMethodByBody OldProcCode="',OldProcCode,'"']);
2860       debugln(['TCodeCompletionCodeTool.CompleteMethodByBody NewProcCode="',NewProcCode,'"']);
2861       {$ENDIF}
2862       // store old cursor position
2863       if not CleanPosToCodePos(CleanCursorPos,OldCodePos) then begin
2864         RaiseException(20170421201627,'TCodeCompletionCodeTool.CompleteMethodByBody Internal Error: '
2865           +'CleanPosToCodePos');
2866       end;
2867 
2868       Indent:=Beauty.GetLineIndent(Src,DefProcNode.StartPos);
2869       FromPos:=DefProcNode.StartPos;
2870       EndPos:=DefProcNode.EndPos;
2871       SourceChangeCache.MainScanner:=Scanner;
2872       NewProcCode:=Beauty.BeautifyStatement(
2873                                   NewProcCode,Indent,[bcfDoNotIndentFirstLine]);
2874       {$IFDEF VerboseCompleteMethod}
2875       debugln('TCodeCompletionCodeTool.CompleteMethodByBody final NewProcCode:');
2876       debugln(NewProcCode);
2877       {$ENDIF}
2878       if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,EndPos,NewProcCode)
2879       then
2880         exit;
2881       Result:=SourceChangeCache.Apply;
2882     end else begin
2883       // insert new definition
2884       ProcName:=ExtractProcName(BodyProcNode,[phpWithoutClassName]);
2885       {$IFDEF VerboseCompleteMethod}
2886       DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody Adding body to definition "',CleanProcCode,'"']);
2887       {$ENDIF}
2888 
2889       // store old cursor position
2890       if not CleanPosToCodePos(CleanCursorPos,OldCodePos) then begin
2891         RaiseException(20170421201630,'TCodeCompletionCodeTool.CompleteMethodByBody Internal Error: '
2892           +'CleanPosToCodePos');
2893       end;
2894 
2895       CodeCompleteSrcChgCache:=SourceChangeCache;
2896 
2897       // add method declaration
2898       NewProcCode:=ExtractProcHead(BodyProcNode,ProcAttrCopyBodyToDef+[phpWithCallingSpecs]);
2899       CleanProcCode:=ExtractProcHead(BodyProcNode,
2900                        [phpWithoutClassKeyword,phpWithoutClassName,phpInUpperCase]);
2901       AddClassInsertion(CleanProcCode,NewProcCode,ProcName,ncpPrivateProcs);
2902 
2903       // apply changes
2904       Result:=ApplyClassCompletion(false);
2905     end;
2906     // adjust cursor position
2907     AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
2908   finally
2909     DisposeAVLTree(ClassProcs);
2910     DisposeAVLTree(ProcBodyNodes);
2911   end;
2912 
2913   {$IFDEF VerboseCompleteMethod}
2914   DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody END OldCodePos.P=',OldCodePos.P,' OldTopLine=',OldTopLine,' NewPos=',Dbgs(NewPos),' NewTopLine=',NewTopLine]);
2915   {$ENDIF}
2916 end;
2917 
CreateParamListFromStatementnull2918 function TCodeCompletionCodeTool.CreateParamListFromStatement(
2919   CursorNode: TCodeTreeNode; BracketOpenPos: integer; out CleanList: string
2920   ): string;
2921 var
2922   ParamNames: TStringToStringTree;
2923 
CreateParamNamenull2924   function CreateParamName(ExprStartPos, ExprEndPos: integer;
2925     const ParamType: string): string;
2926   var
2927     i: Integer;
2928   begin
2929     Result:='';
2930     // use the last identifier of expression as name
2931     MoveCursorToCleanPos(ExprStartPos);
2932     repeat
2933       ReadNextAtom;
2934       if AtomIsIdentifier then
2935         Result:=GetAtom
2936       else
2937         Result:='';
2938     until CurPos.EndPos>=ExprEndPos;
2939     // otherwise use ParamType
2940     if Result='' then
2941       Result:=ParamType;
2942     // otherwise use 'Param'
2943     if not IsValidIdent(Result) then
2944       Result:='Param';
2945     // prepend an 'a'
2946     if Result[1]<>'a' then
2947       Result:='a'+Result;
2948     // make unique
2949     if ParamNames=nil then
2950       ParamNames:=TStringToStringTree.Create(false);
2951     if ParamNames.Contains(Result) then begin
2952       i:=1;
2953       while ParamNames.Contains(Result+IntToStr(i)) do inc(i);
2954       Result:=Result+IntToStr(i);
2955     end;
2956     ParamNames[Result]:='used';
2957   end;
2958 
2959 var
2960   i: Integer;
2961   ExprList: TExprTypeList;
2962   ParamExprType: TExpressionType;
2963   ParamType: String;
2964   ExprStartPos: LongInt;
2965   ExprEndPos: LongInt;
2966   Params: TFindDeclarationParams;
2967   ParamName: String;
2968   // create param list without brackets
2969   {$IFDEF EnableCodeCompleteTemplates}
2970   Colon : String;
2971   {$ENDIF}
2972 begin
2973   Result:='';
2974   CleanList:='';
2975   ExprList:=nil;
2976   ParamNames:=nil;
2977   ActivateGlobalWriteLock;
2978   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2979   try
2980     // check parameter list
2981     ExprList:=CreateParamExprListFromStatement(BracketOpenPos,Params);
2982 
2983     // create parameter list
2984     MoveCursorToCleanPos(BracketOpenPos);
2985     ReadNextAtom;
2986     //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement BracketClose=',BracketClose]);
2987     for i:=0 to ExprList.Count-1 do begin
2988       ReadNextAtom;
2989       ExprStartPos:=CurPos.StartPos;
2990       // read til comma or bracket close
2991       repeat
2992         //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement loop ',GetAtom]);
2993         if (CurPos.StartPos>SrcLen)
2994         or (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose,cafComma])
2995         then
2996           break;
2997         if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
2998           ReadTilBracketClose(true);
2999         end;
3000         ReadNextAtom;
3001       until false;
3002       ExprEndPos:=CurPos.StartPos;
3003       //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement Param=',copy(Src,ExprStartPos,ExprEndPos-ExprStartPos)]);
3004       // get type
3005       ParamExprType:=ExprList.Items[i];
3006       ParamType:=FindExprTypeAsString(ParamExprType,ExprStartPos);
3007       // create a nice parameter name
3008       ParamName:=CreateParamName(ExprStartPos,ExprEndPos,ParamType);
3009       //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement ',i,' ',ParamName,':',ParamType]);
3010       if Result<>'' then begin
3011         Result:=Result+';';
3012         CleanList:=CleanList+';';
3013       end;
3014       {$IFDEF EnableCodeCompleteTemplates}
3015       if assigned(CTTemplateExpander)
3016       and CTTemplateExpander.TemplateExists('PrettyColon') then
3017       begin
3018         Colon := CTTemplateExpander.Expand('PrettyColon', '','', // Doesn't use linebreak or indentation
3019                                  [], [] );
3020         Result:=Result+ParamName+Colon+ParamType;
3021         CleanList:=CleanList+Colon+ParamType;
3022       end
3023       else
3024       {$ENDIF EnableCodeCompleteTemplates}
3025       begin
3026         Result:=Result+ParamName+':'+ParamType;
3027         CleanList:=CleanList+':'+ParamType;
3028       end;
3029       // next
3030       MoveCursorToCleanPos(ExprEndPos);
3031       ReadNextAtom;
3032     end;
3033   finally
3034     ExprList.Free;
3035     Params.Free;
3036     ParamNames.Free;
3037     DeactivateGlobalWriteLock;
3038   end;
3039 end;
3040 
CompleteProcByCallnull3041 function TCodeCompletionCodeTool.CompleteProcByCall(CleanCursorPos,
3042   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
3043   var NewTopLine, BlockTopLine, BlockBottomLine: integer;
3044   SourceChangeCache: TSourceChangeCache): boolean;
3045 // check if 'procname(expr list);'
3046 const
3047   ShortProcFormat = [phpWithoutClassKeyword];
3048 
3049   function CheckProcSyntax(out BeginNode: TCodeTreeNode;
3050     out ProcNameAtom: TAtomPosition;
3051     out BracketOpenPos, BracketClosePos: LongInt): boolean;
3052   begin
3053     Result:=false;
3054     // check if in a begin..end block
3055     if CursorNode=nil then exit;
3056     BeginNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
3057     if BeginNode=nil then exit;
3058     // check if CleanCursorPos is valid
3059     if (CleanCursorPos>SrcLen) then CleanCursorPos:=SrcLen;
3060     if (CleanCursorPos<1) then exit;
3061     // skip bracket
3062     if (Src[CleanCursorPos]='(') then dec(CleanCursorPos);
3063     // go to start of identifier
3064     while (CleanCursorPos>1) and (IsIdentChar[Src[CleanCursorPos-1]]) do
3065       dec(CleanCursorPos);
3066     // read procname
3067     MoveCursorToCleanPos(CleanCursorPos);
3068     ReadNextAtom;
3069     if not AtomIsIdentifier then exit;
3070     ProcNameAtom:=CurPos;
3071     // read bracket
3072     ReadNextAtom;
3073     if CurPos.Flag<>cafRoundBracketOpen then exit;
3074     BracketOpenPos:=CurPos.StartPos;
3075     // read bracket close
3076     if not ReadTilBracketClose(false) then exit;
3077     BracketClosePos:=CurPos.StartPos;
3078     Result:=true;
3079   end;
3080 
3081   function CheckFunctionType(const ProcNameAtom: TAtomPosition;
3082     out IsFunction: Boolean;
3083     out FuncType: String;
3084     out ProcExprStartPos: integer): boolean;
3085   begin
3086     Result:=false;
3087     // find start of proc expression (e.g. Button1.Constrains.DoSomething)
3088     IsFunction:=false;
3089     FuncType:='';
3090     ProcExprStartPos:=FindStartOfTerm(ProcNameAtom.EndPos,false);
3091     if ProcExprStartPos<0 then exit;
3092     MoveCursorToCleanPos(ProcExprStartPos);
3093     ReadPriorAtom;
3094     if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen])
3095     or (UpAtomIs(':=')) then begin
3096       FuncType:='integer';
3097       IsFunction:=true;
3098     end;
3099     Result:=true;
3100   end;
3101 
3102   function CheckProcDoesNotExist(Params: TFindDeclarationParams;
3103     const ProcNameAtom: TAtomPosition): boolean;
3104   begin
3105     Result:=false;
3106     // check if proc already exists
3107     Params.ContextNode:=CursorNode;
3108     Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CheckSrcIdentifier);
3109     Params.Flags:=[fdfSearchInParentNodes,
3110                    fdfTopLvlResolving,fdfSearchInAncestors,fdfSearchInHelpers,
3111                    fdfIgnoreCurContextNode];
3112     if FindIdentifierInContext(Params) then begin
3113       // proc already exists
3114       DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall proc already exists']);
3115       MoveCursorToCleanPos(ProcNameAtom.StartPos);
3116       ReadNextAtom;
3117       RaiseExceptionFmt(20170421201633,ctsIdentifierAlreadyDefined,[GetAtom]);
3118     end;
3119     Result:=true;
3120   end;
3121 
3122   function CreateProcCode(CursorNode: TCodeTreeNode;
3123     const ProcNameAtom: TAtomPosition;
3124     IsFunction: boolean; const FuncType: string;
3125     BracketOpenPos, Indent: integer;
3126     out CleanProcHead, ProcCode: string): boolean;
3127   var
3128     le: String;
3129     ProcName: String;
3130     Beauty: TBeautifyCodeOptions;
3131   begin
3132     Result:=false;
3133 
3134     Beauty:=SourceChangeCache.BeautifyCodeOptions;
3135 
3136     // create param list
3137     ProcCode:=CreateParamListFromStatement(CursorNode,BracketOpenPos,CleanProcHead);
3138     if ProcCode<>'' then begin
3139       ProcCode:='('+ProcCode+')';
3140       CleanProcHead:='('+CleanProcHead+')';
3141     end;
3142 
3143     // prepend proc name
3144     ProcName:=GetAtom(ProcNameAtom);
3145     ProcCode:=ProcName+ProcCode;
3146     CleanProcHead:=ProcName+CleanProcHead;
3147 
3148     // prepend 'procedure' keyword
3149     if IsFunction then
3150     begin
3151       {$IFDEF EnableCodeCompleteTemplates}
3152       if (CTTemplateExpander<>nil)
3153       and CTTemplateExpander.TemplateExists('PrettyColon') then
3154       begin
3155         ProcCode:= 'function '+ProcCode+
3156                    CTTemplateExpander.Expand('PrettyColon','','',[],[])
3157                    +FuncType+';';
3158       end
3159       else
3160       {$ENDIF}
3161       begin
3162         ProcCode:='function '+ProcCode+':'+FuncType+';';
3163       end;
3164     end
3165     else
3166       ProcCode:='procedure '+ProcCode+';';
3167     CleanProcHead:=CleanProcHead+';';
3168 
3169     // append begin..end
3170     le:=Beauty.LineEnd;
3171     ProcCode:=ProcCode+le
3172       +'begin'+le
3173       +le
3174       +'end;';
3175 
3176     ProcCode:=Beauty.BeautifyStatement(ProcCode,Indent);
3177 
3178     DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall ',ProcCode]);
3179     Result:=true;
3180   end;
3181 
3182   function CreatePathForNewProc(InsertPos: integer;
3183     const CleanProcHead: string;
3184     out NewProcPath: TStrings): boolean;
3185   var
3186     ContextNode: TCodeTreeNode;
3187   begin
3188     Result:=false;
3189     // find context at insert position
3190     ContextNode:=FindDeepestNodeAtPos(InsertPos,true);
3191     if (ContextNode.Desc=ctnProcedure) and (ContextNode.StartPos=InsertPos)
3192     or ((ContextNode.LastChild<>nil) and (ContextNode.LastChild.StartPos<InsertPos))
3193     then
3194       // ContextNode is a procedure below or above the insert position
3195       // => after the insert the new proc will not be a child
3196       // -> it will become a child of its parent
3197       ContextNode:=ContextNode.Parent;
3198     NewProcPath:=CreateSubProcPath(ContextNode,ShortProcFormat);
3199     // add new proc
3200     NewProcPath.Add(CleanProcHead);
3201 
3202     DebugLn(['CreatePathForNewProc NewProcPath=',NewProcPath.Text]);
3203     Result:=true;
3204   end;
3205 
3206   function FindJumpPointToNewProc(SubProcPath: TStrings): boolean;
3207   var
3208     NewProcNode: TCodeTreeNode;
3209   begin
3210     Result:=false;
3211     // reparse code and find jump point into new proc
3212     BuildTree(lsrInitializationStart);
3213     NewProcNode:=FindSubProcPath(SubProcPath,ShortProcFormat,true);
3214     if NewProcNode=nil then begin
3215       debugln(['FindJumpPointToNewProc FindSubProcPath failed, SubProcPath="',SubProcPath.Text,'"']);
3216       exit;
3217     end;
3218     Result:=FindJumpPointInProcNode(NewProcNode,NewPos,NewTopLine,BlockTopLine,BlockBottomLine);
3219     { $IFDEF CTDebug}
3220     if Result then
3221       DebugLn('TCodeCompletionCodeTool.CompleteProcByCall END ',NewProcNode.DescAsString,' ',dbgs(Result),' ',dbgs(NewPos.X),',',dbgs(NewPos.Y),' ',dbgs(NewTopLine));
3222     { $ENDIF}
3223   end;
3224 
3225 var
3226   BeginNode: TCodeTreeNode;
3227   ProcNameAtom: TAtomPosition;
3228   BracketOpenPos, BracketClosePos: integer;
3229   ExprType: TExpressionType;
3230   Params: TFindDeclarationParams;
3231   InsertPos: LongInt;
3232   Indent: LongInt;
3233   ExprList: TExprTypeList;
3234   ProcNode: TCodeTreeNode;
3235   ProcCode: String;
3236   ProcExprStartPos: LongInt;
3237   IsFunction: Boolean;
3238   FuncType: String;
3239   CleanProcHead: string;
3240   NewProcPath: TStrings;
3241   Beauty: TBeautifyCodeOptions;
3242 begin
3243   Result:=false;
3244   if not CheckProcSyntax(BeginNode,ProcNameAtom,BracketOpenPos,BracketClosePos)
3245   then exit;
3246   if OldTopLine=0 then ;
3247 
3248   CheckWholeUnitParsed(CursorNode,BeginNode);
3249 
3250   Beauty:=SourceChangeCache.BeautifyCodeOptions;
3251   Params:=TFindDeclarationParams.Create(Self, CursorNode);
3252   ExprList:=nil;
3253   ActivateGlobalWriteLock;
3254   try
3255     if not CheckFunctionType(ProcNameAtom,IsFunction,FuncType,ProcExprStartPos)
3256     then exit;
3257     DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall Call="',copy(Src,ProcNameAtom.StartPos,BracketClosePos+1-ProcNameAtom.StartPos),'"']);
3258     if not CheckProcDoesNotExist(Params,ProcNameAtom) then exit;
3259 
3260     // find context (e.g. Button1.|)
3261     Params.Clear;
3262     Params.ContextNode:=CursorNode;
3263     ExprType:=FindExpressionTypeOfTerm(-1,ProcNameAtom.StartPos,Params,false);
3264     DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall Context: ',ExprTypeToString(ExprType)]);
3265 
3266     if ExprType.Desc=xtNone then begin
3267       // default context
3268       if NodeIsInAMethod(CursorNode) then begin
3269         // eventually: create a new method
3270         DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall ToDo: create a new method']);
3271         exit;
3272       end else begin
3273         ProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
3274         if ProcNode<>nil then begin
3275           // this is a normal proc or nested proc
3276           // insert new proc in front
3277           InsertPos:=FindLineEndOrCodeInFrontOfPosition(ProcNode.StartPos);
3278           Indent:=Beauty.GetLineIndent(Src,ProcNode.StartPos);
3279           debugln(['TCodeCompletionCodeTool.CompleteProcByCall insert as new proc in front of proc']);
3280         end else begin
3281           // this is a begin..end without proc (e.g. program or unit code)
3282           // insert new proc in front
3283           InsertPos:=FindLineEndOrCodeInFrontOfPosition(BeginNode.StartPos);
3284           Indent:=Beauty.GetLineIndent(Src,BeginNode.StartPos);
3285           debugln(['TCodeCompletionCodeTool.CompleteProcByCall insert as new proc in front of begin']);
3286         end;
3287       end;
3288     end else begin
3289       // eventually: create a new method in another class
3290       DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall ToDo: create a new method in another class']);
3291       exit;
3292     end;
3293 
3294     if not CreateProcCode(CursorNode,ProcNameAtom,
3295       IsFunction,FuncType,BracketOpenPos,Indent,
3296       CleanProcHead,ProcCode)
3297     then begin
3298       debugln(['TCodeCompletionCodeTool.CompleteProcByCall CreateProcCode failed']);
3299       exit;
3300     end;
3301 
3302   finally
3303     DeactivateGlobalWriteLock;
3304     Params.Free;
3305     ExprList.Free;
3306   end;
3307 
3308   // insert proc body
3309   //debugln(['TCodeCompletionCodeTool.CompleteProcByCall InsertPos=',CleanPosToStr(InsertPos),' ProcCode="',ProcCode,'"']);
3310   if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
3311     InsertPos,InsertPos,ProcCode)
3312   then
3313     exit;
3314 
3315   // remember old path
3316   NewProcPath:=nil;
3317   try
3318     if not CreatePathForNewProc(InsertPos,CleanProcHead,NewProcPath) then begin
3319       debugln(['TCodeCompletionCodeTool.CompleteProcByCall CreatePathForNewProc failed']);
3320       exit;
3321     end;
3322     if not SourceChangeCache.Apply then begin
3323       debugln(['TCodeCompletionCodeTool.CompleteProcByCall SourceChangeCache.Apply failed']);
3324       exit;
3325     end;
3326     //debugln(['TCodeCompletionCodeTool.CompleteProcByCall ',TCodeBuffer(Scanner.MainCode).Source]);
3327     if not FindJumpPointToNewProc(NewProcPath) then begin
3328       debugln(['TCodeCompletionCodeTool.CompleteProcByCall FindJumpPointToNewProc(',NewProcPath.Text,') failed']);
3329       exit;
3330     end;
3331     Result:=true;
3332   finally
3333     NewProcPath.Free;
3334   end;
3335 end;
3336 
3337 procedure TCodeCompletionCodeTool.DoDeleteNodes(StartNode: TCodeTreeNode);
3338 begin
3339   inherited DoDeleteNodes(StartNode);
3340   FCompletingCursorNode:=nil;
3341   FreeClassInsertionList;
3342 end;
3343 
AddPublishedVariablenull3344 function TCodeCompletionCodeTool.AddPublishedVariable(const UpperClassName,
3345   VarName, VarType: string; SourceChangeCache: TSourceChangeCache): boolean;
3346 begin
3347   Result:=false;
3348   if (UpperClassName='') or (VarName='') or (VarType='')
3349   or (SourceChangeCache=nil) or (Scanner=nil) then exit;
3350   // find classnode
3351   BuildTree(lsrImplementationStart);
3352   // initialize class for code completion
3353   CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
3354   CodeCompleteSrcChgCache:=SourceChangeCache;
3355   // check if variable already exists
3356   if not VarExistsInCodeCompleteClass(UpperCaseStr(VarName)) then begin
3357   {$IFDEF EnableCodeCompleteTemplates}
3358     if (CTTemplateExpander<>nil)
3359     and CTTemplateExpander.TemplateExists('PrettyColon') then
3360     begin
3361       AddClassInsertion(UpperCaseStr(VarName),
3362         VarName+CTTemplateExpander.Expand('PrettyColon','','',[],[])
3363                +VarType+';',VarName,ncpPublishedVars);
3364 
3365     end
3366   else
3367   {$ENDIF}
3368     AddClassInsertion(UpperCaseStr(VarName),
3369                       VarName+':'+VarType+';',VarName,ncpPublishedVars);
3370     if not InsertAllNewClassParts then
3371       RaiseException(20170421201635,ctsErrorDuringInsertingNewClassParts);
3372     // apply the changes
3373     if not SourceChangeCache.Apply then
3374       RaiseException(20170421201637,ctsUnableToApplyChanges);
3375   end;
3376   Result:=true;
3377 end;
3378 
GetRedefinitionNodeTextnull3379 function TCodeCompletionCodeTool.GetRedefinitionNodeText(Node: TCodeTreeNode
3380   ): string;
3381 begin
3382   case Node.Desc of
3383   ctnProcedure:
3384     Result:=ExtractProcHead(Node,[phpInUpperCase,phpWithoutSemicolon]);
3385   ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnEnumIdentifier,
3386   ctnGenericType:
3387     Result:=ExtractDefinitionName(Node);
3388   else
3389     Result:='';
3390   end;
3391 end;
3392 
FindRedefinitionsnull3393 function TCodeCompletionCodeTool.FindRedefinitions(
3394   out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
3395 var
3396   AllNodes: TAVLTree;
3397 
3398   procedure AddRedefinition(Redefinition, Definition: TCodeTreeNode;
3399     const NodeText: string);
3400   var
3401     NodeExt: TCodeTreeNodeExtension;
3402   begin
3403     DebugLn(['AddRedefinition ',NodeText,' Redefined=',CleanPosToStr(Redefinition.StartPos),' Definition=',CleanPosToStr(Definition.StartPos)]);
3404     //DebugLn(['AddRedefinition as source: Definition="',ExtractNode(Definition,[]),'" Redefinition="',ExtractNode(Redefinition,[]),'"']);
3405     NodeExt:=TCodeTreeNodeExtension.Create;
3406     NodeExt.Node:=Redefinition;
3407     NodeExt.Data:=Definition;
3408     NodeExt.Txt:=NodeText;
3409     if TreeOfCodeTreeNodeExt=nil then
3410       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3411     TreeOfCodeTreeNodeExt.Add(NodeExt);
3412   end;
3413 
3414   procedure AddDefinition(Node: TCodeTreeNode; const NodeText: string);
3415   var
3416     NodeExt: TCodeTreeNodeExtension;
3417   begin
3418     NodeExt:=TCodeTreeNodeExtension.Create;
3419     NodeExt.Node:=Node;
3420     NodeExt.Txt:=NodeText;
3421     AllNodes.Add(NodeExt);
3422   end;
3423 
3424 var
3425   Node: TCodeTreeNode;
3426   NodeText: String;
3427   AVLNode: TAVLTreeNode;
3428 begin
3429   Result:=false;
3430   TreeOfCodeTreeNodeExt:=nil;
3431   BuildTree(lsrImplementationStart);
3432 
3433   AllNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3434   try
3435     Node:=Tree.Root;
3436     while Node<>nil do begin
3437       case Node.Desc of
3438       ctnImplementation, ctnInitialization, ctnFinalization,
3439       ctnBeginBlock, ctnAsmBlock:
3440         // skip implementation
3441         break;
3442       ctnVarDefinition, ctnTypeDefinition, ctnConstDefinition, ctnProcedure,
3443       ctnEnumIdentifier, ctnGenericType:
3444         begin
3445           NodeText:=GetRedefinitionNodeText(Node);
3446           AVLNode:=FindCodeTreeNodeExtAVLNode(AllNodes,NodeText);
3447           if AVLNode<>nil then begin
3448             AddRedefinition(Node,TCodeTreeNodeExtension(AVLNode.Data).Node,NodeText);
3449             Node:=Node.NextSkipChilds;
3450           end else begin
3451             AddDefinition(Node,NodeText);
3452             if WithEnums
3453             and (Node.FirstChild<>nil)
3454             and (Node.FirstChild.Desc=ctnEnumerationType) then
3455               Node:=Node.FirstChild
3456             else
3457               Node:=Node.NextSkipChilds;
3458           end;
3459         end;
3460       else
3461         Node:=Node.Next;
3462       end;
3463     end;
3464   finally
3465     DisposeAVLTree(AllNodes);
3466   end;
3467   Result:=true;
3468 end;
3469 
RemoveRedefinitionsnull3470 function TCodeCompletionCodeTool.RemoveRedefinitions(
3471   TreeOfCodeTreeNodeExt: TAVLTree;
3472   SourceChangeCache: TSourceChangeCache): boolean;
3473 var
3474   AVLNode: TAVLTreeNode;
3475   NodesToDo: TAVLTree;// tree of TCodeTreeNode
3476   Node: TCodeTreeNode;
3477   StartNode: TCodeTreeNode;
3478   EndNode: TCodeTreeNode;
3479   IsListStart: Boolean;
3480   IsListEnd: Boolean;
3481   StartPos: LongInt;
3482   EndPos: LongInt;
3483 begin
3484   Result:=false;
3485   if SourceChangeCache=nil then exit;
3486   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
3487     exit(true);
3488   SourceChangeCache.MainScanner:=Scanner;
3489 
3490   NodesToDo:=TAVLTree.Create;
3491   try
3492     // put the nodes to remove into the NodesToDo
3493     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3494     while AVLNode<>nil do begin
3495       Node:=TCodeTreeNodeExtension(AVLNode.Data).Node;
3496       //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions add to NodesToDo ',GetRedefinitionNodeText(Node)]);
3497       NodesToDo.Add(Node);
3498       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3499     end;
3500 
3501     // delete all redefinitions
3502     while NodesToDo.Count>0 do begin
3503       // find a block of redefinitions
3504       StartNode:=TCodeTreeNode(NodesToDo.Root.Data);
3505       //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions StartNode=',StartNode.StartPos,' ',GetRedefinitionNodeText(StartNode)]);
3506       EndNode:=StartNode;
3507       while (StartNode.PriorBrother<>nil)
3508       and (NodesToDo.Find(StartNode.PriorBrother)<>nil) do
3509         StartNode:=StartNode.PriorBrother;
3510       while (EndNode.NextBrother<>nil)
3511       and (NodesToDo.Find(EndNode.NextBrother)<>nil) do
3512         EndNode:=EndNode.NextBrother;
3513       //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions Start=',StartNode.StartPos,' ',GetRedefinitionNodeText(StartNode),' End=',EndNode.StartPos,' ',GetRedefinitionNodeText(EndNode)]);
3514 
3515       // check if a whole section is deleted
3516       if (StartNode.PriorBrother=nil) and (EndNode.NextBrother=nil)
3517       and (StartNode.Parent<>nil)
3518       and (StartNode.Parent.Desc in AllDefinitionSections) then begin
3519         StartNode:=StartNode.Parent;
3520         EndNode:=StartNode;
3521       end;
3522 
3523       // compute nice code positions to delete
3524       StartPos:=FindLineEndOrCodeInFrontOfPosition(StartNode.StartPos);
3525       EndPos:=FindLineEndOrCodeAfterPosition(EndNode.EndPos);
3526 
3527       // check list of definitions
3528       if EndNode.Desc in AllIdentifierDefinitions then begin
3529         // check list definition. For example:
3530         //  delete, delete: char;    ->   delete whole
3531         //  a,delete, delete: char;  ->   a: char;
3532         //  delete,delete,c: char;   ->   c: char;
3533         //  a,delete,delete,c: char; ->   a,c:char;
3534         IsListStart:=(StartNode.PriorBrother=nil)
3535                  or ((StartNode.PriorBrother<>nil)
3536                      and (StartNode.PriorBrother.FirstChild<>nil));
3537         IsListEnd:=(EndNode.FirstChild<>nil);
3538         if IsListStart and IsListEnd then begin
3539           // case 1: delete, delete: char;    ->   delete whole
3540         end else begin
3541           // case 2-4: keep type
3542           // get start position of first deleting identifier
3543           StartPos:=StartNode.StartPos;
3544           // get end position of last deleting identifier
3545           EndPos:=EndNode.StartPos+GetIdentLen(@Src[EndNode.StartPos]);
3546           if IsListEnd then begin
3547             // case 2: a,delete, delete: char;  ->   a: char;
3548             // delete comma in front of start too
3549             MoveCursorToCleanPos(StartNode.PriorBrother.StartPos);
3550             ReadNextAtom; // read identifier
3551             ReadNextAtom; // read comma
3552             StartPos:=CurPos.StartPos;
3553           end else begin
3554             // case 3,4
3555             // delete comma behind end too
3556             MoveCursorToCleanPos(EndNode.StartPos);
3557             ReadNextAtom; // read identifier
3558             ReadNextAtom; // read comma
3559             EndPos:=CurPos.StartPos;
3560           end;
3561         end;
3562       end;
3563 
3564       // replace
3565       DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions deleting:']);
3566       debugln('"',copy(Src,StartPos,EndPos-StartPos),'"');
3567 
3568       if not SourceChangeCache.Replace(gtNone,gtNone,StartPos,EndPos,'') then
3569         exit;
3570 
3571       // remove nodes from NodesToDo
3572       Node:=StartNode;
3573       repeat
3574         NodesToDo.Remove(Node);
3575         //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions removed ',Node.StartPos,' ',GetRedefinitionNodeText(Node),' ',NodesToDo.Find(Node)<>nil]);
3576         Node:=Node.Next;
3577       until (Node=nil) or
3578          ((Node.StartPos>EndNode.StartPos) and (not Node.HasAsParent(EndNode)));
3579     end;
3580   finally
3581     NodesToDo.Free;
3582   end;
3583 
3584   Result:=SourceChangeCache.Apply;
3585 end;
3586 
FindAliasDefinitionsnull3587 function TCodeCompletionCodeTool.FindAliasDefinitions(out
3588   TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
3589 // finds all public definitions of the form 'const A = B;'
3590 var
3591   AllNodes: TAVLTree;
3592 
3593   procedure CheckAlias(Node: TCodeTreeNode);
3594   var
3595     ReferingNode: TCodeTreeNode;
3596     ReferingNodeText: String;
3597     ReferingPos: LongInt;
3598     NodeExt: TCodeTreeNodeExtension;
3599     BracketStartPos: LongInt;
3600     NeededType: TCodeTreeNodeDesc;
3601 
3602     procedure GetReferingNode;
3603     begin
3604       if ReferingNodeText<>'' then exit;
3605       ReferingNodeText:=GetIdentifier(@Src[ReferingPos]);
3606       NodeExt:=FindCodeTreeNodeExtWithIdentifier(AllNodes,PChar(ReferingNodeText));
3607       if (NodeExt<>nil) then
3608         ReferingNode:=NodeExt.Node;
3609     end;
3610 
3611   begin
3612     // check if definition is an alias
3613     // Example:  const A = B;  or   const A = B();
3614 
3615     if (Node.Parent=nil) then exit;
3616     if not (Node.Parent.Desc in [ctnConstSection,ctnTypeSection]) then exit;
3617     // this is a const or type
3618     MoveCursorToNodeStart(Node);
3619     // read A
3620     ReadNextAtom;
3621     if CurPos.Flag<>cafWord then exit;
3622     // read =
3623     ReadNextAtom;
3624     if CurPos.Flag<>cafEqual then exit;
3625     // read B
3626     ReadNextAtom;
3627     if CurPos.Flag<>cafWord then exit;
3628     ReferingPos:=CurPos.StartPos;
3629     ReadNextAtom;
3630     if CurPos.Flag=cafRoundBracketOpen then begin
3631       BracketStartPos:=CurPos.StartPos;
3632       ReadTilBracketClose(true);
3633       //BracketEndPos:=CurPos.StartPos;
3634       ReadNextAtom;
3635     end else
3636       BracketStartPos:=0;
3637     if CurPos.Flag<>cafSemicolon then exit;
3638 
3639     ReferingNode:=nil;
3640     NeededType:=ctnNone;
3641 
3642     if BracketStartPos>0 then begin
3643       if WordIsKeyWord.DoItCaseInsensitive(@Src[ReferingPos]) then
3644         exit;
3645       // this is a type cast
3646       NeededType:=ctnConstDefinition;
3647       //GetReferingNode;
3648       if (ReferingNode<>nil) then begin
3649         // ToDo: check if it is a typecast to a procedure type
3650         // then the alias should be replaced with a procdure
3651         //if (ReferingNode=ctnTypeDefinition)
3652       end;
3653     end else begin
3654       // this is a const or type alias
3655       //DebugLn(['TCodeCompletionCodeTool.FindAliasDefinitions Alias: ',Node.DescAsString,' ',ExtractNode(Node,[])]);
3656       GetReferingNode;
3657       if (ReferingNode<>nil) then begin
3658         NeededType:=ReferingNode.Desc;
3659       end;
3660     end;
3661     if NeededType=ctnNone then exit;
3662     // add alias
3663     if NeededType<>Node.Desc then begin
3664       DebugLn(['TCodeCompletionCodeTool.FindAliasDefinitions Wrong: ',Node.DescAsString,' ',ExtractNode(Node,[]),' ',Node.DescAsString,'<>',NodeDescToStr(NeededType)]);
3665     end;
3666     if TreeOfCodeTreeNodeExt=nil then
3667       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3668     NodeExt:=TCodeTreeNodeExtension.Create;
3669     NodeExt.Node:=Node;
3670     NodeExt.Txt:=GetRedefinitionNodeText(Node);
3671     NodeExt.Data:=ReferingNode;
3672     NodeExt.Flags:=NeededType;
3673     TreeOfCodeTreeNodeExt.Add(NodeExt);
3674   end;
3675 
3676   procedure UpdateDefinition(const NodeText: string; Node: TCodeTreeNode);
3677   var
3678     AVLNode: TAVLTreeNode;
3679     NodeExt: TCodeTreeNodeExtension;
3680   begin
3681     AVLNode:=FindCodeTreeNodeExtAVLNode(AllNodes,NodeText);
3682     if AVLNode=nil then begin
3683       // add new node
3684       NodeExt:=TCodeTreeNodeExtension.Create;
3685       NodeExt.Node:=Node;
3686       NodeExt.Txt:=NodeText;
3687       AllNodes.Add(NodeExt);
3688     end else begin
3689       // update node
3690       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3691       NodeExt.Node:=Node;
3692     end;
3693   end;
3694 
3695   procedure CollectAllDefinitions;
3696   var
3697     Node: TCodeTreeNode;
3698   begin
3699     Node:=Tree.Root;
3700     while Node<>nil do begin
3701       case Node.Desc of
3702       ctnImplementation, ctnInitialization, ctnFinalization,
3703       ctnBeginBlock, ctnAsmBlock:
3704         // skip implementation
3705         break;
3706       ctnTypeDefinition, ctnConstDefinition:
3707         begin
3708           // remember the definition
3709           UpdateDefinition(GetRedefinitionNodeText(Node),Node);
3710           Node:=Node.NextSkipChilds;
3711         end;
3712       ctnProcedure:
3713         begin
3714           UpdateDefinition(ExtractProcName(Node,[]),Node);
3715           Node:=Node.NextSkipChilds;
3716         end;
3717       else
3718         Node:=Node.Next;
3719       end;
3720     end;
3721   end;
3722 
3723   procedure CollectAllAliasDefinitions;
3724   var
3725     Node: TCodeTreeNode;
3726   begin
3727     Node:=Tree.Root;
3728     while Node<>nil do begin
3729       case Node.Desc of
3730       ctnImplementation, ctnInitialization, ctnFinalization,
3731       ctnBeginBlock, ctnAsmBlock:
3732         // skip implementation
3733         break;
3734       ctnTypeDefinition, ctnConstDefinition:
3735         begin
3736           CheckAlias(Node);
3737           Node:=Node.NextSkipChilds;
3738         end;
3739       ctnProcedure:
3740         Node:=Node.NextSkipChilds;
3741       else
3742         Node:=Node.Next;
3743       end;
3744     end;
3745   end;
3746 
3747   procedure ResolveAliases;
3748 
3749     function FindAliasRoot(Node: TCodeTreeNode;
3750       out NeededRootDesc: TCodeTreeNodeDesc): TCodeTreeNode;
3751     var
3752       AliasText: String;
3753       AVLNode: TAVLTreeNode;
3754       ReferingNode: TCodeTreeNode;
3755       OldDesc: TCodeTreeNodeDesc;
3756       NodeExt: TCodeTreeNodeExtension;
3757     begin
3758       Result:=Node;
3759       NeededRootDesc:=Node.Desc;
3760       if Node.Desc=ctnProcedure then
3761         AliasText:=ExtractProcName(Node,[])
3762       else
3763         AliasText:=GetRedefinitionNodeText(Node);
3764       if AliasText='' then exit;
3765       AVLNode:=FindCodeTreeNodeExtAVLNode(TreeOfCodeTreeNodeExt,AliasText);
3766       if AVLNode=nil then exit;
3767       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3768       NeededRootDesc:=TCodeTreeNodeDesc(NodeExt.Flags);
3769 
3770       ReferingNode:=TCodeTreeNode(NodeExt.Data);
3771       if ReferingNode=nil then exit;
3772       // this is an alias => search further
3773       if ReferingNode.Desc=ctnNone then begin
3774         // circle
3775         exit;
3776       end;
3777       // mark node as visited
3778       OldDesc:=Node.Desc;
3779       Node.Desc:=ctnNone;
3780       Result:=FindAliasRoot(ReferingNode,NeededRootDesc);
3781       // unmark node as visited
3782       Node.Desc:=OldDesc;
3783       if NeededRootDesc=ctnNone then
3784         NeededRootDesc:=Node.Desc;
3785     end;
3786 
3787   var
3788     AVLNode: TAVLTreeNode;
3789     NodeExt: TCodeTreeNodeExtension;
3790     ReferingNode: TCodeTreeNode;
3791     NeededType: TCodeTreeNodeDesc;
3792   begin
3793     if TreeOfCodeTreeNodeExt=nil then exit;
3794     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3795     while AVLNode<>nil do begin
3796       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3797       ReferingNode:=TCodeTreeNode(NodeExt.Data);
3798       if ReferingNode<>nil then begin
3799         // this node is an alias.
3800         // => find the root alias
3801         ReferingNode:=FindAliasRoot(ReferingNode,NeededType);
3802         NodeExt.Data:=ReferingNode;
3803         NodeExt.Flags:=NeededType;
3804       end;
3805       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3806     end;
3807   end;
3808 
3809   procedure RemoveGoodAliases;
3810   var
3811     AVLNode: TAVLTreeNode;
3812     NodeExt: TCodeTreeNodeExtension;
3813     NeededType: TCodeTreeNodeDesc;
3814     NextAVLNode: TAVLTreeNode;
3815   begin
3816     if TreeOfCodeTreeNodeExt=nil then exit;
3817     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3818     while AVLNode<>nil do begin
3819       NextAVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3820       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3821       NeededType:=TCodeTreeNodeDesc(NodeExt.Flags);
3822       if NodeExt.Node.Desc=NeededType then begin
3823         TreeOfCodeTreeNodeExt.FreeAndDelete(AVLNode);
3824       end;
3825       AVLNode:=NextAVLNode;
3826     end;
3827   end;
3828 
3829 begin
3830   Result:=false;
3831   TreeOfCodeTreeNodeExt:=nil;
3832   BuildTree(lsrImplementationStart);
3833 
3834   AllNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3835   try
3836     if OnlyWrongType then
3837       CollectAllDefinitions;
3838     CollectAllAliasDefinitions;
3839     if OnlyWrongType then begin
3840       ResolveAliases;
3841       RemoveGoodAliases;
3842     end;
3843   finally
3844     DisposeAVLTree(AllNodes);
3845   end;
3846   Result:=true;
3847 end;
3848 
FixAliasDefinitionsnull3849 function TCodeCompletionCodeTool.FixAliasDefinitions(
3850   TreeOfCodeTreeNodeExt: TAVLTree; SourceChangeCache: TSourceChangeCache
3851   ): boolean;
3852 { replaces public dummy functions with a constant.
3853   The function body will be removed.
3854   See the function FindAliasDefinitions.
3855 }
3856   function FindReferingNodeExt(DefNode: TCodeTreeNode): TCodeTreeNodeExtension;
3857   var
3858     AVLNode: TAVLTreeNode;
3859     NodeExt: TCodeTreeNodeExtension;
3860   begin
3861     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3862     while AVLNode<>nil do begin
3863       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3864       if NodeExt.Node=DefNode then begin
3865         Result:=NodeExt;
3866         exit;
3867       end;
3868       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3869     end;
3870     Result:=nil;
3871   end;
3872 
3873 var
3874   AVLNode: TAVLTreeNode;
3875   NodeExt: TCodeTreeNodeExtension;
3876   DefNode: TCodeTreeNode;
3877   ReferingNode: TCodeTreeNode;
3878   NextAVLNode: TAVLTreeNode;
3879   ReferingNodeInFront: TCodeTreeNodeExtension;
3880   ReferingNodeBehind: TCodeTreeNodeExtension;
3881   NewSrc: String;
3882   FromPos: LongInt;
3883   ToPos: LongInt;
3884   ReferingType: TCodeTreeNodeDesc;
3885   NewSection: String;
3886   ProcName: String;
3887   OldProcName: String;
3888 begin
3889   Result:=false;
3890   if SourceChangeCache=nil then exit;
3891   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
3892     exit(true);
3893   SourceChangeCache.MainScanner:=Scanner;
3894 
3895   // remove all nodes which can not be handled here
3896   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3897   while AVLNode<>nil do begin
3898     NextAVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3899     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3900     DefNode:=NodeExt.Node;
3901     ReferingType:=TCodeTreeNodeDesc(NodeExt.Flags);
3902     ReferingNode:=TCodeTreeNode(NodeExt.Data);
3903     if (ReferingType=ctnProcedure) then begin
3904       // procedure alias => check if it is an 'external' procedure
3905       if (ReferingNode=nil) or (ReferingNode.Desc<>ctnProcedure)
3906       or (not ProcNodeHasSpecifier(ReferingNode,psEXTERNAL)) then
3907         ReferingType:=ctnNone;
3908     end;
3909     if (not (ReferingType in [ctnTypeDefinition,ctnConstDefinition,ctnProcedure]))
3910     or (DefNode.Desc=ReferingType) then begin
3911       TreeOfCodeTreeNodeExt.FreeAndDelete(AVLNode);
3912     end;
3913     AVLNode:=NextAVLNode;
3914   end;
3915 
3916   // insert additional sections
3917   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3918   while AVLNode<>nil do begin
3919     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3920     DefNode:=NodeExt.Node;
3921     ReferingType:=TCodeTreeNodeDesc(NodeExt.Flags);
3922     ReferingNode:=TCodeTreeNode(NodeExt.Data);
3923 
3924     //DebugLn(['TCodeCompletionCodeTool.FixAliasDefinitions Old=',DefNode.DescAsString,' New=',NodeDescToStr(ReferingType)]);
3925 
3926     // check in front
3927     if ReferingType in [ctnTypeDefinition,ctnConstDefinition] then begin
3928       case ReferingType of
3929       ctnTypeDefinition: NewSection:='type';
3930       ctnConstDefinition: NewSection:='const';
3931       ctnProcedure: NewSection:=''; // Changed from NewSrc to NewSection. Is it correct? Juha
3932       else NewSection:='bug';
3933       end;
3934 
3935       if DefNode.PriorBrother=nil then begin
3936         // this is the start of the section
3937         MoveCursorToNodeStart(DefNode.Parent);
3938         ReadNextAtom;
3939         if not SourceChangeCache.Replace(gtNone,gtNone,
3940           CurPos.StartPos,CurPos.EndPos,NewSection) then exit;
3941       end else begin
3942         // this is not the start of the section
3943         ReferingNodeInFront:=FindReferingNodeExt(DefNode.PriorBrother);
3944         if (ReferingNodeInFront=nil)
3945         or (TCodeTreeNodeDesc(ReferingNodeInFront.Flags)<>ReferingType) then
3946         begin
3947           // the node in front has a different section
3948           FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
3949           if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
3950              FromPos,FromPos,NewSection) then exit;
3951         end;
3952       end;
3953     end else if ReferingType=ctnProcedure then begin
3954       // alias to an external procedure
3955       // => replace alias with complete external procedure header
3956 
3957       if DefNode.PriorBrother=nil then begin
3958         // this is the start of the section
3959         FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.Parent.StartPos);
3960         ToPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
3961         if not SourceChangeCache.Replace(gtNone,gtNone,
3962           FromPos,ToPos,'') then exit;
3963       end;
3964 
3965       NewSrc:=ExtractProcHead(ReferingNode,[phpWithStart,phpWithVarModifiers,
3966         phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
3967         phpWithOfObject,phpWithCallingSpecs,phpWithProcModifiers]);
3968       OldProcName:=ExtractProcName(ReferingNode,[]);
3969       FromPos:=System.Pos(OldProcName,NewSrc);
3970       if DefNode.Desc in [ctnTypeDefinition,ctnConstDefinition] then
3971         ProcName:=ExtractDefinitionName(DefNode)
3972       else if DefNode.Desc=ctnProcedure then
3973         ProcName:=ExtractProcName(DefNode,[])
3974       else
3975         ProcName:=NodeExt.Txt;
3976       NewSrc:=copy(NewSrc,1,FromPos-1)+ProcName
3977              +copy(NewSrc,FromPos+length(OldProcName),length(NewSrc));
3978       FromPos:=DefNode.StartPos;
3979       ToPos:=DefNode.EndPos;
3980       if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewSrc)
3981       then
3982         exit;
3983     end;
3984 
3985     // check behind
3986     if DefNode.NextBrother=nil then begin
3987       // this is the end of the section
3988     end else begin
3989       // this is not the end of the section
3990       ReferingNodeBehind:=FindReferingNodeExt(DefNode.NextBrother);
3991       if ReferingNodeBehind<>nil then begin
3992         // the next node will change the section
3993       end else begin
3994         // the next node should stay in the same type of section
3995         case DefNode.NextBrother.Desc of
3996         ctnTypeDefinition: NewSrc:='type';
3997         ctnConstDefinition: NewSrc:='const';
3998         else NewSrc:='';
3999         end;
4000         if NewSrc<>'' then begin
4001           FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.NextBrother.StartPos);
4002           if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
4003              FromPos,FromPos,NewSrc) then exit;
4004         end;
4005       end;
4006     end;
4007 
4008     AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4009   end;
4010   Result:=SourceChangeCache.Apply;
4011 end;
4012 
FindConstFunctionsnull4013 function TCodeCompletionCodeTool.FindConstFunctions(
4014   out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4015 { find public dummy functions that can be replaced with a constant
4016   For example:
4017 
4018       function MPI_CONVERSION_FN_NULL : PMPI_Datarep_conversion_function;
4019       begin
4020          MPI_CONVERSION_FN_NULL:=PMPI_Datarep_conversion_function(0);
4021       end;
4022 
4023    Where the expression only contains unit defined types, constants,
4024    variables, built-in const functions and no members nor functions.
4025 
4026     NodeExt.Txt: description
4027     NodeExt.Node: definition node
4028     NodeExt.Data: function body node
4029     NodeExt.ExtTxt1: ExtractCode(ExprStart,ExprEnd,[]);
4030 }
4031 var
4032   Definitions: TAVLTree;
4033 
4034   function FindProcWithName(Identifier: PChar): TCodeTreeNodeExtension;
4035   begin
4036     Result:=FindCodeTreeNodeExtWithIdentifier(Definitions,Identifier);
4037   end;
4038 
4039   procedure CheckProcNode(ProcNode: TCodeTreeNode);
4040   // check if node is a function (not class function)
4041   var
4042     Node: TCodeTreeNode;
4043     FuncName: String;
4044     ExprStart: LongInt;
4045     NodeText: String;
4046     NodeExt: TCodeTreeNodeExtension;
4047     ExprEnd: LongInt;
4048     ResultNodeExt: TCodeTreeNodeExtension;
4049 
4050     function CheckExprIdentifier(Identifier: PChar): boolean;
4051     var
4052       NodeExt: TCodeTreeNodeExtension;
4053       NewPos: Integer;
4054       AtomStart: integer;
4055     begin
4056       Result:=true;
4057       if CompareIdentifiers('Result',Identifier)=0 then exit;
4058       if CompareIdentifiers(PChar(FuncName),Identifier)=0 then exit;
4059       // check for const and type definitions
4060       NodeExt:=FindCodeTreeNodeExt(Definitions,GetIdentifier(Identifier));
4061       if NodeExt=nil then
4062         NodeExt:=FindProcWithName(Identifier);
4063 
4064       if (NodeExt<>nil) and (NodeExt.Node<>nil) then begin
4065         if NodeExt.Node.Desc in [ctnConstDefinition,ctnTypeDefinition] then
4066           exit;
4067         if (NodeExt.Node.Desc=ctnProcedure) and IsPCharInSrc(Identifier) then
4068         begin
4069           // read atom behind identifier name
4070           NewPos:=PtrInt({%H-}PtrUInt(Identifier))-PtrInt({%H-}PtrUInt(@Src[1]))+1;
4071           inc(NewPos,GetIdentLen(Identifier));
4072           ReadRawNextPascalAtom(Src,NewPos,AtomStart,Scanner.NestedComments,true);
4073           if (AtomStart<=SrcLen) and (Src[AtomStart]<>'(') then begin
4074             // no parameters
4075             // this is the function pointer, not the result => constant
4076             exit;
4077           end;
4078         end;
4079       end;
4080 
4081       // check for compiler built in operators, constants and types
4082       if IsWordBuiltInFunc.DoItCaseInsensitive(Identifier) then exit;
4083       if WordIsBinaryOperator.DoItCaseInsensitive(Identifier) then exit;
4084       if WordIsPredefinedFPCIdentifier.DoItCaseInsensitive(Identifier) then exit;
4085       Result:=false;
4086     end;
4087 
4088   begin
4089     if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
4090     //DebugLn(['CheckProcNode START ',ExtractProcHead(ProcNode,[])]);
4091     MoveCursorToNodeStart(ProcNode);
4092     // read 'function'
4093     ReadNextAtom;
UNCTIONnull4094     if not UpAtomIs('FUNCTION') then exit;
4095     // read name
4096     ReadNextAtom;
4097     FuncName:=GetAtom;
4098     ReadNextAtom;
4099     if CurPos.Flag=cafRoundBracketOpen then begin
4100       // skip optional empty parameter list ()
4101       ReadNextAtom;
4102       if CurPos.Flag<>cafRoundBracketClose then exit;
4103       ReadNextAtom;
4104     end;
4105     // read :
4106     if CurPos.Flag<>cafColon then exit;
4107     // read result type
4108     ReadNextAtom;
4109     if not AtomIsIdentifier then exit;
4110 
4111     // check if there is a public definition of the procedure
4112     NodeText:=GetRedefinitionNodeText(ProcNode);
4113     if TreeOfCodeTreeNodeExt<>nil then begin
4114       ResultNodeExt:=FindCodeTreeNodeExt(TreeOfCodeTreeNodeExt,NodeText);
4115       if ResultNodeExt<>nil then begin
4116         DebugLn(['CheckProcNode function exists twice']);
4117         exit;
4118       end;
4119     end;
4120 
4121     NodeExt:=FindCodeTreeNodeExt(Definitions,NodeText);
4122     if (NodeExt=nil) or (NodeExt.Node=nil) or (NodeExt.Node.Desc<>ctnProcedure)
4123     then begin
4124       DebugLn(['CheckProcNode function is not public NodeText=',NodeText]);
4125       exit;
4126     end;
4127 
4128     // check child nodes only contain the proc head and a begin block
4129     Node:=ProcNode.FirstChild;
4130     if Node=nil then exit;
4131     if Node.Desc=ctnProcedureHead then begin
4132       Node:=Node.NextBrother;
4133       if Node=nil then exit;
4134     end;
4135     if Node.Desc<>ctnBeginBlock then exit;
4136 
4137     //DebugLn(['CheckProcNode has begin block']);
4138 
4139     // check begin block is only a single assignment
4140     MoveCursorToNodeStart(Node);
4141     // read begin
4142     ReadNextAtom;
4143     // read 'Result' or 'FunctionName'
4144     ReadNextAtom;
4145     if (not UpAtomIs('RESULT')) and (not AtomIs(FuncName)) then exit;
4146     // read :=
4147     ReadNextAtom;
4148     if not UpAtomIs(':=') then exit;
4149     // read expression
4150     ReadNextAtom;
4151     ExprStart:=CurPos.StartPos;
4152     ExprEnd:=ExprStart;
4153     while (CurPos.EndPos<=Node.EndPos) do begin
4154       if (CurPos.Flag in [cafSemicolon,cafEnd]) then
4155         break;
4156       // check if all identifiers can be used in a constant expression
4157       if AtomIsIdentifier
4158       and not CheckExprIdentifier(@Src[CurPos.StartPos]) then
4159         exit;
4160       ExprEnd:=CurPos.EndPos;
4161       ReadNextAtom;
4162     end;
4163     if ExprStart=ExprEnd then exit;
4164 
4165     //DebugLn(['CheckProcNode FOUND']);
4166 
4167     // save values
4168     ResultNodeExt:=TCodeTreeNodeExtension.Create;
4169     ResultNodeExt.Txt:=NodeText;
4170     ResultNodeExt.Node:=NodeExt.Node;
4171     ResultNodeExt.Data:=ProcNode;
4172     ResultNodeExt.ExtTxt1:=ExtractCode(ExprStart,ExprEnd,[]);
4173     if TreeOfCodeTreeNodeExt=nil then
4174       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
4175     TreeOfCodeTreeNodeExt.Add(ResultNodeExt);
4176   end;
4177 
4178 var
4179   Node: TCodeTreeNode;
4180 begin
4181   Result:=false;
4182   TreeOfCodeTreeNodeExt:=nil;
4183 
4184   try
4185     BuildTree(lsrImplementationStart);
4186 
4187     // first step: find all unit identifiers (excluding implementation section)
4188     if not GatherUnitDefinitions(Definitions,true,true) then exit;
4189     //DebugLn(['TCodeCompletionCodeTool.FindConstFunctions ',Src]);
4190 
4191     // now check all functions
4192     Node:=Tree.Root;
4193     while Node<>nil do begin
4194       case Node.Desc of
4195       ctnInterface, ctnUsesSection, ctnBeginBlock, ctnAsmBlock, ctnProcedureHead,
4196       ctnTypeSection, ctnConstSection, ctnVarSection, ctnResStrSection:
4197         Node:=Node.NextSkipChilds;
4198       ctnProcedure:
4199         begin
4200           CheckProcNode(Node);
4201           Node:=Node.NextSkipChilds;
4202         end;
4203       else
4204         Node:=Node.Next;
4205       end;
4206     end;
4207 
4208   finally
4209     DisposeAVLTree(Definitions);
4210   end;
4211   Result:=true;
4212 end;
4213 
ReplaceConstFunctionsnull4214 function TCodeCompletionCodeTool.ReplaceConstFunctions(
4215   TreeOfCodeTreeNodeExt: TAVLTree; SourceChangeCache: TSourceChangeCache
4216   ): boolean;
4217 { replaces public dummy functions with a constant.
4218   The function body will be removed.
4219   See the function FindConstFunctions.
4220 }
4221   function IsConstSectionNeeded(Node: TCodeTreeNode): boolean;
4222   var
4223     AVLNode: TAVLTreeNode;
4224     NodeExt: TCodeTreeNodeExtension;
4225   begin
4226     if Node.PriorBrother.Desc=ctnConstSection then exit(false);
4227     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4228     while AVLNode<>nil do begin
4229       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4230       if NodeExt.Node=Node.PriorBrother then begin
4231         // the function in front will be replaced too
4232         exit(false);
4233       end;
4234       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4235     end;
4236     Result:=true;
4237   end;
4238 
4239 var
4240   AVLNode: TAVLTreeNode;
4241   NodeExt: TCodeTreeNodeExtension;
4242   DefNode: TCodeTreeNode;
4243   BodyNode: TCodeTreeNode;
4244   Expr: String;
4245   FromPos: LongInt;
4246   ToPos: LongInt;
4247   NewSrc: String;
4248   Beauty: TBeautifyCodeOptions;
4249 begin
4250   Result:=false;
4251   if SourceChangeCache=nil then exit;
4252   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
4253     exit(true);
4254   SourceChangeCache.MainScanner:=Scanner;
4255   Beauty:=SourceChangeCache.BeautifyCodeOptions;
4256 
4257   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4258   while AVLNode<>nil do begin
4259     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4260     DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions ',NodeExt.Txt]);
4261     DefNode:=NodeExt.Node;
4262     BodyNode:=TCodeTreeNode(NodeExt.Data);
4263     Expr:=NodeExt.ExtTxt1;
4264     DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions Expr=',Expr]);
4265 
4266     // remove body node
4267     FromPos:=FindLineEndOrCodeInFrontOfPosition(BodyNode.StartPos);
4268     ToPos:=FindLineEndOrCodeAfterPosition(BodyNode.EndPos);
4269     if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) then begin
4270       inc(ToPos);
4271       if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13])
4272       and (Src[ToPos-1]<>Src[ToPos]) then
4273         inc(ToPos);
4274     end;
4275     DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions Body="',copy(Src,FromPos,ToPos-FromPos),'"']);
4276     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4277 
4278     // replace definition
4279     FromPos:=DefNode.StartPos;
4280     ToPos:=DefNode.EndPos;
4281     if Src[ToPos]=';' then inc(ToPos);// add semicolon
4282     NewSrc:=Beauty.GetIndentStr(Beauty.Indent)
4283       +ExtractProcName(DefNode,[])+' = '+Expr+';';
4284     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewSrc);
4285     // add 'const' keyword
4286     if IsConstSectionNeeded(DefNode) then begin
4287       FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
4288       SourceChangeCache.Replace(gtEmptyLine,gtNewLine,FromPos,FromPos,'const');
4289     end;
4290 
4291     AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4292   end;
4293   Result:=SourceChangeCache.Apply;
4294 end;
4295 
FindTypeCastFunctionsnull4296 function TCodeCompletionCodeTool.FindTypeCastFunctions(out
4297   TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4298 { find public dummy functions that can be replaced with a type
4299   For example:
4300 
4301   function PMPI_Win_f2c(win : longint) : MPI_Win;
4302     begin
4303        PMPI_Win_f2c:=MPI_Win(win);
4304     end;
4305 
4306    Where the expression is Result := ResultType(Parameter).
4307 
4308     NodeExt.Txt: description
4309     NodeExt.Node: definition node
4310     NodeExt.Data: function body node
4311     NodeExt.ExtTxt1: ResultType
4312 }
4313 var
4314   Definitions: TAVLTree;
4315 
4316   procedure CheckProcNode(ProcNode: TCodeTreeNode);
4317   // check if node is a function (not class function)
4318   var
4319     Node: TCodeTreeNode;
4320     FuncName: PChar;
4321     NodeText: String;
4322     NodeExt: TCodeTreeNodeExtension;
4323     ResultNodeExt: TCodeTreeNodeExtension;
4324     ParamName: PChar;
4325     ResultType: PChar;
4326   begin
4327     if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
4328     //DebugLn(['CheckProcNode START ',ExtractProcHead(ProcNode,[])]);
4329     MoveCursorToNodeStart(ProcNode);
4330     ReadNextAtom;
4331     // read 'function'
UNCTIONnull4332     if not UpAtomIs('FUNCTION') then exit;
4333     ReadNextAtom;
4334     // read name
4335     if CurPos.Flag<>cafWord then exit;
4336     FuncName:=@Src[CurPos.StartPos];
4337     ReadNextAtom;
4338     // read (
4339     if CurPos.Flag<>cafRoundBracketOpen then exit;
4340     ReadNextAtom;
4341     // read optional const
4342     if UpAtomIs('CONST') then
4343       ReadNextAtom;
4344     // read parameter name
4345     if CurPos.Flag<>cafWord then exit;
4346     ParamName:=@Src[CurPos.StartPos];
4347     ReadNextAtom;
4348     // read :
4349     if CurPos.Flag<>cafColon then exit;
4350     ReadNextAtom;
4351     // read parameter type
4352     if CurPos.Flag<>cafWord then exit;
4353     ReadNextAtom;
4354     // read )
4355     if CurPos.Flag<>cafRoundBracketClose then exit;
4356     ReadNextAtom;
4357     // read :
4358     if CurPos.Flag<>cafColon then exit;
4359     // read result type
4360     ReadNextAtom;
4361     if CurPos.Flag<>cafWord then exit;
4362     ResultType:=@Src[CurPos.StartPos];
4363 
4364     // check if there is a public definition of the procedure
4365     NodeText:=GetRedefinitionNodeText(ProcNode);
4366     if TreeOfCodeTreeNodeExt<>nil then begin
4367       ResultNodeExt:=FindCodeTreeNodeExt(TreeOfCodeTreeNodeExt,NodeText);
4368       if ResultNodeExt<>nil then begin
4369         DebugLn(['CheckProcNode function exists twice']);
4370         exit;
4371       end;
4372     end;
4373 
4374     NodeExt:=FindCodeTreeNodeExt(Definitions,NodeText);
4375     if (NodeExt=nil) or (NodeExt.Node=nil) or (NodeExt.Node.Desc<>ctnProcedure)
4376     then begin
4377       DebugLn(['CheckProcNode function is not public NodeText=',NodeText]);
4378       exit;
4379     end;
4380 
4381     // check child nodes only contain the proc head and a begin block
4382     Node:=ProcNode.FirstChild;
4383     if Node=nil then exit;
4384     if Node.Desc=ctnProcedureHead then begin
4385       Node:=Node.NextBrother;
4386       if Node=nil then exit;
4387     end;
4388     if Node.Desc<>ctnBeginBlock then exit;
4389 
4390     //DebugLn(['CheckProcNode has begin block']);
4391 
4392     // check begin block is only a single assignment
4393     MoveCursorToNodeStart(Node);
4394     // read begin
4395     ReadNextAtom;
4396     // read 'Result' or 'FunctionName'
4397     ReadNextAtom;
4398     if CurPos.Flag<>cafWord then exit;
4399     if (not UpAtomIs('RESULT'))
4400     and (CompareIdentifiers(FuncName,@Src[CurPos.StartPos])<>0) then exit;
4401     // read :=
4402     ReadNextAtom;
4403     if not UpAtomIs(':=') then exit;
4404     // read type cast to result type
4405     ReadNextAtom;
4406     if CurPos.Flag<>cafWord then exit;
4407     if (CompareIdentifiers(ResultType,@Src[CurPos.StartPos])<>0) then exit;
4408     // read (
4409     ReadNextAtom;
4410     if CurPos.Flag<>cafRoundBracketOpen then exit;
4411     // read parameter
4412     ReadNextAtom;
4413     if CurPos.Flag<>cafWord then exit;
4414     if (CompareIdentifiers(ParamName,@Src[CurPos.StartPos])<>0) then exit;
4415     // read )
4416     ReadNextAtom;
4417     if CurPos.Flag<>cafRoundBracketClose then exit;
4418     //DebugLn(['CheckProcNode FOUND']);
4419 
4420     // save values
4421     ResultNodeExt:=TCodeTreeNodeExtension.Create;
4422     ResultNodeExt.Txt:=NodeText;
4423     ResultNodeExt.Node:=NodeExt.Node;
4424     ResultNodeExt.Data:=ProcNode;
4425     ResultNodeExt.ExtTxt1:=GetIdentifier(ResultType);
4426     if TreeOfCodeTreeNodeExt=nil then
4427       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
4428     TreeOfCodeTreeNodeExt.Add(ResultNodeExt);
4429   end;
4430 
4431 var
4432   Node: TCodeTreeNode;
4433 begin
4434   Result:=false;
4435   TreeOfCodeTreeNodeExt:=nil;
4436   try
4437     BuildTree(lsrImplementationStart);
4438 
4439     // first step: find all unit identifiers (excluding implementation section)
4440     if not GatherUnitDefinitions(Definitions,true,true) then exit;
4441 
4442     // now check all functions
4443     Node:=Tree.Root;
4444     while Node<>nil do begin
4445       case Node.Desc of
4446       ctnInterface, ctnUsesSection, ctnBeginBlock, ctnAsmBlock, ctnProcedureHead,
4447       ctnTypeSection, ctnConstSection, ctnVarSection, ctnResStrSection:
4448         Node:=Node.NextSkipChilds;
4449       ctnProcedure:
4450         begin
4451           CheckProcNode(Node);
4452           Node:=Node.NextSkipChilds;
4453         end;
4454       else
4455         Node:=Node.Next;
4456       end;
4457     end;
4458 
4459   finally
4460     DisposeAVLTree(Definitions);
4461   end;
4462   Result:=true;
4463 end;
4464 
ReplaceTypeCastFunctionsnull4465 function TCodeCompletionCodeTool.ReplaceTypeCastFunctions(
4466   TreeOfCodeTreeNodeExt: TAVLTree; SourceChangeCache: TSourceChangeCache
4467   ): boolean;
4468 { replaces public dummy functions with a type.
4469   The function body will be removed.
4470   See the function FindTypeCastFunctions.
4471 }
4472   function IsTypeSectionNeeded(Node: TCodeTreeNode): boolean;
4473   var
4474     AVLNode: TAVLTreeNode;
4475     NodeExt: TCodeTreeNodeExtension;
4476   begin
4477     if Node.PriorBrother.Desc=ctnTypeSection then exit(false);
4478     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4479     while AVLNode<>nil do begin
4480       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4481       if NodeExt.Node=Node.PriorBrother then begin
4482         // the function in front will be replaced too
4483         exit(false);
4484       end;
4485       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4486     end;
4487     Result:=true;
4488   end;
4489 
4490 var
4491   AVLNode: TAVLTreeNode;
4492   NodeExt: TCodeTreeNodeExtension;
4493   DefNode: TCodeTreeNode;
4494   BodyNode: TCodeTreeNode;
4495   Expr: String;
4496   FromPos: LongInt;
4497   ToPos: LongInt;
4498   NewSrc: String;
4499   Beauty: TBeautifyCodeOptions;
4500 begin
4501   Result:=false;
4502   if SourceChangeCache=nil then exit;
4503   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
4504     exit(true);
4505   SourceChangeCache.MainScanner:=Scanner;
4506   Beauty:=SourceChangeCache.BeautifyCodeOptions;
4507 
4508   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4509   while AVLNode<>nil do begin
4510     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4511     DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions ',NodeExt.Txt]);
4512     DefNode:=NodeExt.Node;
4513     BodyNode:=TCodeTreeNode(NodeExt.Data);
4514     Expr:=NodeExt.ExtTxt1;
4515     DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions Expr=',Expr]);
4516 
4517     // remove body node
4518     FromPos:=FindLineEndOrCodeInFrontOfPosition(BodyNode.StartPos);
4519     ToPos:=FindLineEndOrCodeAfterPosition(BodyNode.EndPos);
4520     if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) then begin
4521       inc(ToPos);
4522       if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13])
4523       and (Src[ToPos-1]<>Src[ToPos]) then
4524         inc(ToPos);
4525     end;
4526     DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions Body="',copy(Src,FromPos,ToPos-FromPos),'"']);
4527     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4528 
4529     // replace definition
4530     FromPos:=DefNode.StartPos;
4531     ToPos:=DefNode.EndPos;
4532     if Src[ToPos]=';' then inc(ToPos);// add semicolon
4533     NewSrc:=Beauty.GetIndentStr(Beauty.Indent)
4534       +ExtractProcName(DefNode,[])+' = '+Expr+';';
4535     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewSrc);
4536     // add 'type' keyword
4537     if IsTypeSectionNeeded(DefNode) then begin
4538       FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
4539       SourceChangeCache.Replace(gtEmptyLine,gtNewLine,FromPos,FromPos,'type');
4540     end;
4541 
4542     AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4543   end;
4544   Result:=SourceChangeCache.Apply;
4545 end;
4546 
MovePointerTypesToTargetSectionsnull4547 function TCodeCompletionCodeTool.MovePointerTypesToTargetSections(
4548   SourceChangeCache: TSourceChangeCache): boolean;
4549 const
4550   NodeMovedFlag = 1;
4551 var
4552   NodeMoves: TCodeGraph;// an edge means, move the FromNode in front of the ToNode
4553   Beauty: TBeautifyCodeOptions;
4554 
4555   procedure InitNodeMoves;
4556   begin
4557     if NodeMoves=nil then
4558       NodeMoves:=TCodeGraph.Create;
4559   end;
4560 
4561   procedure ClearNodeMoves;
4562   begin
4563     FreeAndNil(NodeMoves);
4564   end;
4565 
4566   procedure AddMove(Node, InsertInFrontOf: TCodeTreeNode);
4567   begin
4568     if Node=InsertInFrontOf then exit;
4569     if Node=nil then RaiseException(20170421201640,'inconsistency');
4570     if InsertInFrontOf=nil then RaiseException(20170421201643,'inconsistency');
4571     NodeMoves.AddEdge(Node,InsertInFrontOf);
4572   end;
4573 
4574   function WholeSectionIsMoved(SectionNode: TCodeTreeNode): boolean;
4575   var
4576     Node: TCodeTreeNode;
4577     GraphNode: TCodeGraphNode;
4578   begin
4579     Node:=SectionNode.FirstChild;
4580     while Node<>nil do begin
4581       GraphNode:=NodeMoves.GetGraphNode(Node,false);
4582       if (GraphNode=nil) or (GraphNode.OutTreeCount=0) then
4583         exit(false);
4584       Node:=Node.NextBrother;
4585     end;
4586     Result:=true;
4587   end;
4588 
4589   function ApplyNodeMove(GraphNode: TCodeGraphNode; MoveNode: boolean;
4590     InsertPos, Indent: integer): boolean;
4591   // if MoveNode=true then move code of GraphNode.Node to InsertPos
4592   // Always: move recursively all nodes that should be moved to GraphNode too
4593   var
4594     AVLNode: TAVLTreeNode;
4595     GraphEdge: TCodeGraphEdge;
4596     Node: TCodeTreeNode;
4597     FromPos: LongInt;
4598     ToPos: LongInt;
4599     NodeSrc: String;
4600   begin
4601     Result:=false;
4602     Node:=GraphNode.Node;
4603     // marked as moved
4604     GraphNode.Flags:=NodeMovedFlag;
4605     DebugLn(['ApplyNodeMoves ',ExtractNode(Node,[])]);
4606     if MoveNode then begin
4607       FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4608       ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
4609       NodeSrc:=Beauty.GetIndentStr(Indent)+Trim(copy(Src,FromPos,ToPos-FromPos));
4610       // remove
4611       if (Node.PriorBrother=nil)
4612       and (Node.Parent<>nil) and (Node.Parent.Desc in AllDefinitionSections)
4613       and WholeSectionIsMoved(Node.Parent)
4614       then begin
4615         // the whole section is moved and this is the first node of the section
4616         // remove the section header too
4617         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.Parent.StartPos);
4618       end;
4619       DebugLn(['ApplyNodeMove Remove: "',copy(Src,FromPos,ToPos-FromPos),'"']);
4620       if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then exit;
4621       // insert
4622       DebugLn(['ApplyNodeMove Insert: "',NodeSrc,'"']);
4623       if not SourceChangeCache.Replace(gtNewLine,gtNewLine,
4624         InsertPos,InsertPos,NodeSrc) then exit;
4625     end;
4626     // move dependent nodes
4627     if GraphNode.InTree<>nil then begin
4628       AVLNode:=GraphNode.InTree.FindLowest;
4629       while AVLNode<>nil do begin
4630         GraphEdge:=TCodeGraphEdge(AVLNode.Data);
4631         if not ApplyNodeMove(GraphEdge.FromNode,true,InsertPos,Indent) then exit;
4632         AVLNode:=GraphNode.InTree.FindSuccessor(AVLNode);
4633       end;
4634     end;
4635     Result:=true;
4636   end;
4637 
4638   function ApplyNodeMoves(ExceptionOnCircle: boolean): boolean;
4639   var
4640     GraphEdge: TCodeGraphEdge;
4641     ListOfGraphNodes: TFPList;
4642     i: Integer;
4643     GraphNode: TCodeGraphNode;
4644     InsertPos: LongInt;
4645     Indent: LongInt;
4646   begin
4647     Result:=false;
4648     if NodeMoves.Edges.Count=0 then exit(true);
4649 
4650     // check that every node has no more than one destination
4651     GraphNode:=NodeMoves.FindGraphNodeWithNumberOfOutEdges(2,-1);
4652     if GraphNode<>nil then begin
4653       DebugLn(['TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves inconsistency: node should be moved to several places: ',ExtractNode(GraphNode.Node,[])]);
4654       raise Exception.Create('TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves node should be moved to several places');
4655     end;
4656 
4657     // sort topologically and break all circles
4658     repeat
4659       GraphEdge:=NodeMoves.GetTopologicalSortedList(ListOfGraphNodes,true,false,true);
4660       if GraphEdge=nil then break;
4661       if ExceptionOnCircle then
4662         raise Exception.Create('TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves found circle: From='+ExtractNode(GraphEdge.FromNode.Node,[])+' To='+ExtractNode(GraphEdge.ToNode.Node,[]));
4663       DebugLn(['TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves break circle: From=',ExtractNode(GraphEdge.FromNode.Node,[]),' To=',ExtractNode(GraphEdge.ToNode.Node,[])]);
4664       NodeMoves.DeleteEdge(GraphEdge);
4665       ListOfGraphNodes.Free;
4666     until false;
4667 
4668     for i:=0 to ListOfGraphNodes.Count-1 do begin
4669       GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
4670       DebugLn(['ApplyNodeMoves i=',i,' ',ExtractNode(GraphNode.Node,[]),' InFrontCnt=',GraphNode.InTreeCount,' BehindCnt=',GraphNode.OutTreeCount]);
4671     end;
4672 
4673     { apply changes
4674       the ListOfGraphNodes is sorted topologically with nodes at end must be
4675       moved first
4676       For example:
4677         var AnArray: array[0..EndValue] of char;
4678         const EndValue = TMyInteger(1);
4679         type TMyInteger = longint;
4680       Edges: TMyInteger -> AnArray
4681              EndValue -> AnArray
4682       List:
4683     }
4684     NodeMoves.ClearNodeFlags;
4685     for i:=ListOfGraphNodes.Count-1 downto 0 do begin
4686       GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
4687       if GraphNode.Flags=0 then begin
4688         InsertPos:=FindLineEndOrCodeInFrontOfPosition(GraphNode.Node.StartPos);
4689         Indent:=Beauty.GetLineIndent(Src,GraphNode.Node.StartPos);
4690         if not ApplyNodeMove(GraphNode,false,InsertPos,Indent) then exit;
4691       end;
4692     end;
4693     Result:=SourceChangeCache.Apply;
4694   end;
4695 
4696 var
4697   Definitions: TAVLTree;// tree of TCodeTreeNodeExtension
4698   Graph: TCodeGraph;
4699   AVLNode: TAVLTreeNode;
4700   NodeExt: TCodeTreeNodeExtension;
4701   Node: TCodeTreeNode;
4702   GraphNode: TCodeGraphNode;
4703   RequiredAVLNode: TAVLTreeNode;
4704   GraphEdge: TCodeGraphEdge;
4705   RequiredNode: TCodeTreeNode;
4706   RequiredTypeNode: TCodeTreeNode;
4707 begin
4708   Result:=false;
4709   if (SourceChangeCache=nil) or (Scanner=nil) then exit;
4710   NodeMoves:=nil;
4711   Definitions:=nil;
4712   Graph:=nil;
4713   Beauty:=SourceChangeCache.BeautifyCodeOptions;
4714   try
4715     // move the pointer types to the same type sections
4716     if not BuildUnitDefinitionGraph(Definitions,Graph,false) then exit;
4717     SourceChangeCache.MainScanner:=Scanner;
4718     if Definitions=nil then exit(true);
4719     InitNodeMoves;
4720 
4721     AVLNode:=Definitions.FindLowest;
4722     while AVLNode<>nil do begin
4723       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4724       Node:=NodeExt.Node;
4725       if (Node.Desc=ctnTypeDefinition) and (Node.FirstChild<>nil)
4726       and (Node.FirstChild.Desc=ctnPointerType) then begin
4727         // this is a pointer type
4728         // check if it only depends on the type nodes of a single section
4729         //DebugLn(['MovePointerTypesToTargetSections Pointer=',ExtractNode(Node,[])]);
4730         RequiredTypeNode:=nil;
4731         GraphNode:=Graph.GetGraphNode(Node,false);
4732         if GraphNode.OutTree<>nil then begin
4733           RequiredAVLNode:=GraphNode.OutTree.FindLowest;
4734           while RequiredAVLNode<>nil do begin
4735             GraphEdge:=TCodeGraphEdge(RequiredAVLNode.Data);
4736             RequiredNode:=GraphEdge.ToNode.Node;
4737             if (RequiredNode.Desc=ctnTypeDefinition)
4738             and (RequiredNode.Parent.Desc=ctnTypeSection) then begin
4739               //DebugLn(['MovePointerTypesToTargetSections required=',ExtractNode(RequiredNode,[])]);
4740               if RequiredTypeNode=nil then begin
4741                 RequiredTypeNode:=RequiredNode;
4742               end
4743               else if RequiredTypeNode.Parent<>RequiredNode.Parent then begin
4744                 DebugLn(['MovePointerTypesToTargetSections required nodes in different type sections']);
4745                 RequiredTypeNode:=nil;
4746                 break;
4747               end;
4748             end else begin
4749               DebugLn(['MovePointerTypesToTargetSections required nodes are not only types']);
4750               RequiredTypeNode:=nil;
4751               break;
4752             end;
4753             RequiredAVLNode:=GraphNode.OutTree.FindSuccessor(RequiredAVLNode);
4754           end;
4755         end;
4756         if (RequiredTypeNode<>nil) then begin
4757           // this pointer type depends only on the type nodes of a single type
4758           // section
4759           if (Node.Parent<>RequiredNode.Parent) then begin
4760             // pointer type is in other section => move
4761             DebugLn(['MovePointerTypesToTargetSections move Pointer=',ExtractNode(Node,[]),' Required=',ExtractNode(RequiredNode,[])]);
4762             AddMove(Node,RequiredNode);
4763           end;
4764         end;
4765       end;
4766       AVLNode:=Definitions.FindSuccessor(AVLNode);
4767     end;
4768     Result:=ApplyNodeMoves(false);
4769   finally
4770     DisposeAVLTree(Definitions);
4771     Graph.Free;
4772     ClearNodeMoves;
4773   end;
4774 end;
4775 
FixForwardDefinitionsnull4776 function TCodeCompletionCodeTool.FixForwardDefinitions(
4777   SourceChangeCache: TSourceChangeCache): boolean;
4778 
4779   function UpdateGraph(var Definitions: TAVLTree; var Graph: TCodeGraph;
4780     Rebuild: boolean): boolean;
4781   begin
4782     if Definitions<>nil then begin
4783       DisposeAVLTree(Definitions);
4784     end;
4785     if Graph<>nil then begin
4786       Graph.Free;
4787       Graph:=nil;
4788     end;
4789     if Rebuild then
4790       Result:=BuildUnitDefinitionGraph(Definitions,Graph,true)
4791     else
4792       Result:=true;
4793   end;
4794 
4795   function CreateTypeSectionForCycle(CycleOfGraphNodes: TFPList;
4796     var Definitions: TAVLTree; var Graph: TCodeGraph): boolean;
4797   // CycleOfGraphNodes is a list of TCodeGraphNode that should be moved
4798   // to a new type section
4799 
4800     function IndexOfNode(Node: TCodeTreeNode): integer;
4801     begin
4802       Result:=CycleOfGraphNodes.Count-1;
4803       while (Result>=0)
4804       and (TCodeGraphNode(CycleOfGraphNodes[Result]).Node<>Node) do
4805         dec(Result);
4806     end;
4807 
4808   var
4809     i: Integer;
4810     GraphNode: TCodeGraphNode;
4811     Node: TCodeTreeNode;
4812     NewTxt: String;
4813     EndGap: TGapTyp;
4814     InsertPos: LongInt;
4815     Indent: LongInt;
4816     FromPos: LongInt;
4817     ToPos: LongInt;
4818     Beauty: TBeautifyCodeOptions;
4819   begin
4820     // check if whole type sections are moved and combine them
4821     i:=CycleOfGraphNodes.Count-1;
4822     while i>=0 do begin
4823       GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4824       Node:=GraphNode.Node;
4825       if Node.Parent.Desc=ctnTypeSection then begin
4826         if IndexOfNode(Node.Parent)>=0 then begin
4827           // the whole type section of this type will be moved
4828           // => remove this type
4829           CycleOfGraphNodes.Delete(i);
4830         end else begin
4831           // check if all types of this type section will be moved
4832           Node:=Node.Parent.FirstChild;
4833           while (Node<>nil) and (IndexOfNode(Node)>=0) do
4834             Node:=Node.NextBrother;
4835           if Node=nil then begin
4836             // all types of this type section will be moved
4837             // => remove the type and add the type section instead
4838             CycleOfGraphNodes.Delete(i);
4839             CycleOfGraphNodes.Add(Graph.AddGraphNode(GraphNode.Node.Parent));
4840           end;
4841         end;
4842       end;
4843       dec(i);
4844     end;
4845 
4846     // create new type section
4847     Beauty:=SourceChangeCache.BeautifyCodeOptions;
4848     // Note: InsertPos must be outside the types and type sections which are moved
4849     GraphNode:=TCodeGraphNode(CycleOfGraphNodes[0]);
4850     Node:=GraphNode.Node;
4851     if Node.Parent.Desc=ctnTypeSection then
4852       Node:=Node.Parent;
4853     InsertPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4854     Indent:=Beauty.GetLineIndent(Src,Node.StartPos);
4855     SourceChangeCache.Replace(gtEmptyLine,gtNewLine,InsertPos,InsertPos,
4856       Beauty.GetIndentStr(Indent)+'type');
4857     inc(Indent,Beauty.Indent);
4858     // move the types
4859     for i:=0 to CycleOfGraphNodes.Count-1 do begin
4860       GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4861       Node:=GraphNode.Node;
4862       if i=CycleOfGraphNodes.Count-1 then
4863         EndGap:=gtEmptyLine
4864       else
4865         EndGap:=gtNewLine;
4866       if Node.Desc=ctnTypeSection then begin
4867         // remove type section
4868         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4869         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos,true);
4870         DebugLn(['CreateTypeSectionForCircle Removing type section: ',ExtractCode(FromPos,ToPos,[])]);
4871         SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4872         // add all types of type section to new type section
4873         if Node.FirstChild<>nil then begin
4874           FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.FirstChild.StartPos);
4875           ToPos:=FindLineEndOrCodeAfterPosition(Node.LastChild.EndPos);
4876           NewTxt:=Beauty.GetIndentStr(Indent)+ExtractCode(FromPos,ToPos,[phpWithComments]);
4877           DebugLn(['CreateTypeSectionForCircle Adding types: ',NewTxt]);
4878           SourceChangeCache.Replace(gtNewLine,EndGap,InsertPos,InsertPos,NewTxt);
4879         end;
4880       end else if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
4881         // remove type
4882         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4883         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
4884         DebugLn(['CreateTypeSectionForCircle Removing node: ',ExtractCode(FromPos,ToPos,[])]);
4885         SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4886         // add type to new type section
4887         NewTxt:=Beauty.GetIndentStr(Indent)+ExtractNode(Node,[phpWithComments]);
4888         DebugLn(['CreateTypeSectionForCircle Adding type: ',NewTxt]);
4889         SourceChangeCache.Replace(gtNewLine,EndGap,InsertPos,InsertPos,NewTxt);
4890       end else
4891         raise Exception.Create('inconsistency');
4892     end;
4893     // apply changes
4894     Result:=SourceChangeCache.Apply;
4895     if not Result then exit;
4896     // rebuild graph
4897     Result:=UpdateGraph(Definitions,Graph,true);
4898   end;
4899 
4900   function FixCycle(var Definitions: TAVLTree;
4901     var Graph: TCodeGraph; CircleNode: TCodeGraphNode): boolean;
4902   var
4903     CycleOfGraphNodes: TFPList; // list of TCodeGraphNode
4904 
4905     procedure RaiseCanNotFixCircle(const Msg: string);
4906     var
4907       i: Integer;
4908       GraphNode: TCodeGraphNode;
4909       s: String;
4910     begin
4911       DebugLn(['RaiseCanNotFixCircle Msg="',Msg,'"']);
4912       s:='Can not auto fix a circle in definitions: '+Msg;
4913       for i:=0 to CycleOfGraphNodes.Count-1 do begin
4914         GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4915         DebugLn(['  ',i,': ',GetRedefinitionNodeText(GraphNode.Node)]);
4916       end;
4917       raise Exception.Create(s);
4918     end;
4919 
4920   var
4921     i: Integer;
4922     GraphNode: TCodeGraphNode;
4923     ParentNode: TCodeTreeNode;
4924     Node: TCodeTreeNode;
4925     NeedsMoving: Boolean;
4926   begin
4927     Result:=false;
4928     CycleOfGraphNodes:=nil;
4929     try
4930       // get all nodes of this CycleOfGraphNodes
4931       Graph.GetMaximumCircle(CircleNode,CycleOfGraphNodes);
4932       // check if all nodes are types
4933       for i:=0 to CycleOfGraphNodes.Count-1 do begin
4934         GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4935         if not (GraphNode.Node.Desc in [ctnTypeDefinition,ctnGenericType])
4936         then begin
4937           RaiseCanNotFixCircle('Only types can build circles, not '+GraphNode.Node.DescAsString);
4938         end;
4939       end;
4940       NeedsMoving:=false;
4941       // check if the whole type CycleOfGraphNodes has one parent
4942       ParentNode:=TCodeGraphNode(CycleOfGraphNodes[0]).Node.Parent;
4943       for i:=1 to CycleOfGraphNodes.Count-1 do begin
4944         GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4945         if GraphNode.Node.Parent<>ParentNode then begin
4946           DebugLn(['FixCycle cycle is not yet in one type section -> needs moving']);
4947           NeedsMoving:=true;
4948           break;
4949         end;
4950       end;
4951       // check if the parent only contains the CycleOfGraphNodes nodes
4952       if not NeedsMoving then begin
4953         Node:=ParentNode.FirstChild;
4954         while Node<>nil do begin
4955           i:=CycleOfGraphNodes.Count-1;
4956           while (i>=0) and (TCodeGraphNode(CycleOfGraphNodes[i]).Node<>Node) do dec(i);
4957           if i<0 then begin
4958             DebugLn(['FixCycle cycle has not yet its own type section -> needs moving']);
4959             NeedsMoving:=true;
4960             break;
4961           end;
4962           Node:=Node.NextBrother;
4963         end;
4964       end;
4965 
4966       if NeedsMoving then begin
4967         DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions.FixCycle moving types into one type section']);
4968         Result:=CreateTypeSectionForCycle(CycleOfGraphNodes,Definitions,Graph);
4969         exit;
4970       end else begin
4971         // remove definitions nodes and use the type section instead
4972         DebugLn(['FixCycle already ok']);
4973         Graph.CombineNodes(CycleOfGraphNodes,Graph.GetGraphNode(ParentNode,true));
4974       end;
4975 
4976     finally
4977       CycleOfGraphNodes.Free;
4978     end;
4979     Result:=true;
4980   end;
4981 
4982   function BreakCycles(var Definitions: TAVLTree;
4983     var Graph: TCodeGraph): boolean;
4984   var
4985     ListOfGraphNodes: TFPList;
4986     CycleEdge: TCodeGraphEdge;
4987   begin
4988     Result:=false;
4989     ListOfGraphNodes:=nil;
4990     try
4991       Graph.DeleteSelfCircles;
4992       repeat
4993         //WriteCodeGraphDebugReport(Graph);
4994         CycleEdge:=Graph.GetTopologicalSortedList(ListOfGraphNodes,true,false,false);
4995         if CycleEdge=nil then break;
4996         DebugLn(['FixForwardDefinitions.CheckCircles Circle found containing ',
4997           GetRedefinitionNodeText(CycleEdge.FromNode.Node),
4998           ' and ',
4999           GetRedefinitionNodeText(CycleEdge.ToNode.Node)]);
5000         if not FixCycle(Definitions,Graph,CycleEdge.FromNode) then exit;
5001       until false;
5002     finally
5003       ListOfGraphNodes.Free;
5004     end;
5005     Result:=true;
5006   end;
5007 
5008   function MoveNodes(TreeOfNodeMoveEdges: TAVLTree): boolean;
5009   // TreeOfNodeMoveEdges is a tree of TNodeMoveEdge
5010   // it is sorted for insert position (i.e. left node must be inserted
5011   //   in front of right node)
5012 
5013     function NodeWillBeMoved(Node: TCodeTreeNode): boolean;
5014     var
5015       AVLNode: TAVLTreeNode;
5016       CurMove: TNodeMoveEdge;
5017       GraphNode: TCodeGraphNode;
5018     begin
5019       AVLNode:=TreeOfNodeMoveEdges.FindLowest;
5020       while AVLNode<>nil do begin
5021         CurMove:=TNodeMoveEdge(AVLNode.Data);
5022         GraphNode:=CurMove.GraphNode;
5023         if GraphNode.Node=Node then exit(true);
5024         AVLNode:=TreeOfNodeMoveEdges.FindSuccessor(AVLNode);
5025       end;
5026       Result:=false;
5027     end;
5028 
5029     function GetFirstVarDefSequenceNode(Node: TCodeTreeNode): TCodeTreeNode;
5030     begin
5031       while (Node.PriorBrother<>nil) and (Node.PriorBrother.FirstChild=nil) do
5032         Node:=Node.PriorBrother;
5033       Result:=Node;
5034     end;
5035 
5036     function GetLastVarDefSequenceNode(Node: TCodeTreeNode): TCodeTreeNode;
5037     begin
5038       Result:=nil;
5039       while (Node<>nil) do begin
5040         Result:=Node;
5041         if (Node.FirstChild<>nil) then break;
5042         Node:=Node.NextBrother;
5043       end;
5044     end;
5045 
5046     function WholeVarDefSequenceWillBeMoved(Node: TCodeTreeNode): boolean;
5047     // test, if all variable definitions of a sequence will be moved
5048     // example: var a,b,c: integer;
5049     begin
5050       Node:=GetFirstVarDefSequenceNode(Node);
5051       while (Node<>nil) do begin
5052         if not NodeWillBeMoved(Node) then exit(false);
5053         if (Node.FirstChild<>nil) then break;// this is the last of the sequence
5054         Node:=Node.NextBrother;
5055       end;
5056       Result:=true;
5057     end;
5058 
5059     function WholeSectionWillBeMoved(Node: TCodeTreeNode): boolean;
5060     // test, if all child nodes will be moved
5061     begin
5062       Node:=Node.FirstChild;
5063       while (Node<>nil) do begin
5064         if not NodeWillBeMoved(Node) then exit(false);
5065         Node:=Node.NextBrother;
5066       end;
5067       Result:=true;
5068     end;
5069 
5070   var
5071     AVLNode: TAVLTreeNode;
5072     CurMove: TNodeMoveEdge;
5073     GraphNode: TCodeGraphNode;// move what
5074     PosGraphNode: TCodeGraphNode;// move where (in front of)
5075     Node: TCodeTreeNode;
5076     FromPos: LongInt;
5077     ToPos: LongInt;
5078     DestNode: TCodeTreeNode;
5079     NextAVLNode: TAVLTreeNode;
5080     NextMove: TNodeMoveEdge;
5081     NextGraphNode: TCodeGraphNode;// move what next
5082     NextPosGraphNode: TCodeGraphNode;// move where next (in front of)
5083     NextInsertAtSamePos: boolean;
5084     NeedSection: TCodeTreeNodeDesc;
5085     LastSection: TCodeTreeNodeDesc;
5086     LastInsertAtSamePos: boolean;
5087     InsertPos: LongInt;
5088     Indent: LongInt;
5089     DestSection: TCodeTreeNodeDesc;
5090     NewTxt: String;
5091     DestNodeInFront: TCodeTreeNode;
5092     Beauty: TBeautifyCodeOptions;
5093   begin
5094     Result:=false;
5095     AVLNode:=TreeOfNodeMoveEdges.FindLowest;
5096     LastSection:=ctnNone;
5097     LastInsertAtSamePos:=false;
5098     DestNode:=nil;
5099     DestSection:=ctnNone;
5100     Beauty:=SourceChangeCache.BeautifyCodeOptions;
5101     // process every move
5102     while AVLNode<>nil do begin
5103       CurMove:=TNodeMoveEdge(AVLNode.Data);
5104       GraphNode:=CurMove.GraphNode;// move what
5105       PosGraphNode:=TCodeGraphNode(GraphNode.Data);// move where (in front of)
5106       NextAVLNode:=TreeOfNodeMoveEdges.FindSuccessor(AVLNode);
5107       if NextAVLNode<>nil then begin
5108         NextMove:=TNodeMoveEdge(NextAVLNode.Data);
5109         NextGraphNode:=NextMove.GraphNode;// move what next
5110         NextPosGraphNode:=TCodeGraphNode(NextGraphNode.Data);// move where next
5111         NextInsertAtSamePos:=NextPosGraphNode=PosGraphNode;
5112       end else begin
5113         NextInsertAtSamePos:=false;
5114       end;
5115       DebugLn(['MoveNodes: move ',
5116         GetRedefinitionNodeText(GraphNode.Node),' ',CleanPosToStr(GraphNode.Node.StartPos),
5117         ' (TopoLvl=',CurMove.TologicalLevel,')',
5118         ' in front of ',GetRedefinitionNodeText(PosGraphNode.Node),' ',CleanPosToStr(PosGraphNode.Node.StartPos)
5119         ]);
5120       Node:=GraphNode.Node;
5121       DestNode:=PosGraphNode.Node;
5122 
5123       // remove node
5124       if (Node.Parent<>nil)
5125       and (Node.Parent.Desc in AllDefinitionSections)
5126       and WholeSectionWillBeMoved(Node.Parent) then begin
5127         // the whole type/var/const section will be moved
5128         if Node.PriorBrother=nil then begin
5129           // this is the first node of the section
5130           // => remove the whole section
5131           FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.Parent.StartPos);
5132           ToPos:=FindLineEndOrCodeAfterPosition(Node.Parent.EndPos,true);
5133         end else begin
5134           // this is not the first node of the section
5135           // => remove nothing
5136           FromPos:=0;
5137           ToPos:=0;
5138         end;
5139       end
5140       else if Node.Desc=ctnVarDefinition then begin
5141         // removing a variable definition can be tricky, because for example
5142         // var a,b,c: integer;
5143         if Node.FirstChild<>nil then begin
5144           // this is the last of a sequence
5145           if WholeVarDefSequenceWillBeMoved(Node) then begin
5146             // the whole variable definition will be moved
5147             // and this is the last of the sequence
5148             // => remove the whole definition (names and type)
5149             FromPos:=FindLineEndOrCodeInFrontOfPosition(
5150                                      GetFirstVarDefSequenceNode(Node).StartPos);
5151             ToPos:=FindLineEndOrCodeAfterPosition(
5152                                    GetLastVarDefSequenceNode(Node).EndPos,true);
5153           end else if NodeWillBeMoved(Node.PriorBrother) then begin
5154             // this is for example: var a,b,c: integer
5155             // and only b and c will be moved. The b, plus the space behind was
5156             // already marked for removal
5157             // => remove the c and the space behind
5158             FromPos:=Node.StartPos;
5159             MoveCursorToNodeStart(Node);
5160             ReadNextAtom;// read identifier
5161             AtomIsIdentifierE;
5162             ToPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos,true);
5163           end else begin
5164             // this is for example: var a,b: integer
5165             // and only b will be moved.
5166             // => remove ,b plus the space behind
5167             MoveCursorToNodeStart(Node.PriorBrother);
5168             ReadNextAtom;// read identifier
5169             AtomIsIdentifierE;
5170             ReadNextAtom;// read comma
5171             if not AtomIsChar(',') then RaiseCharExpectedButAtomFound(20170421201647,',');
5172             FromPos:=CurPos.StartPos;
5173             ReadNextAtom;// read identifier
5174             AtomIsIdentifierE;
5175             ReadNextAtom;//read colon
5176             if not AtomIsChar(':') then RaiseCharExpectedButAtomFound(20170421201651,':');
5177             ToPos:=CurPos.StartPos;
5178           end;
5179         end else begin
5180           // this is not the last of a sequence
5181           if WholeVarDefSequenceWillBeMoved(Node) then begin
5182             // the whole sequence will be moved. This is done by the last node.
5183             // => nothing to do
5184             FromPos:=0;
5185             ToPos:=0;
5186           end else begin
5187             // remove the b,
5188             FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
5189             MoveCursorToNodeStart(Node);
5190             ReadNextAtom;// read identifier
5191             AtomIsIdentifierE;
5192             ReadNextAtom;// read comma
5193             if not AtomIsChar(',') then RaiseCharExpectedButAtomFound(20170421201654,',');
5194             ToPos:=CurPos.StartPos;
5195           end;
5196         end;
5197       end else begin
5198         // remove the whole node
5199         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
5200         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
5201       end;
5202       if ToPos>FromPos then begin
5203         DebugLn(['MoveNodes remove "',ExtractCode(FromPos,ToPos,[]),'"']);
5204         if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then
5205           exit;
5206       end;
5207 
5208       // find needed section type
5209       if Node.Desc in AllIdentifierDefinitions then
5210         NeedSection:=Node.Parent.Desc
5211       else
5212         NeedSection:=ctnNone;
5213 
5214       // find insert position
5215       if not LastInsertAtSamePos then begin
5216         //DebugLn(['MoveNodes LastInsertAtSamePos=false, compute destination ...']);
5217         if (DestNode.Desc in AllIdentifierDefinitions) then begin
5218           DestNode:=GetFirstVarDefSequenceNode(DestNode);
5219           DestSection:=DestNode.Parent.Desc;
5220           if DestNode.PriorBrother<>nil then begin
5221             // the destination is in front of a definition, but in the middle
5222             // of a section
5223             // example: type a=char; | b=byte;
5224             // => insert in front of destination
5225             //DebugLn(['MoveNodes destination is middle of a section. Node in front=',GetRedefinitionNodeText(DestNode.PriorBrother)]);
5226           end else begin
5227             // the destination is the first node of a section
5228             // example: type | t=char;
5229             if NeedSection=DestSection then begin
5230               // insertion needs the same section type
5231               // => insert in front of destination
5232             end else begin
5233               // insertion needs another section type
5234               // => insert in front of the section
5235               DestNode:=DestNode.Parent;
5236             end;
5237             //DebugLn(['MoveNodes destination is first node of a section ']);
5238           end;
5239         end else begin
5240           // the destination is not in a section
5241           // example: in front of a type section
5242           // => insert in front of destination
5243           // find the section in front
5244           DestNodeInFront:=DestNode.PriorBrother;
5245           while (DestNodeInFront<>nil) and NodeWillBeMoved(DestNodeInFront) do
5246             DestNodeInFront:=DestNodeInFront.PriorBrother;
5247           if (DestNodeInFront<>nil)
5248           and (DestNodeInFront.Desc in AllDefinitionSections) then
5249             DestSection:=DestNodeInFront.Desc
5250           else
5251             DestSection:=ctnNone;
5252           //DebugLn(['MoveNodes destination is not in a section']);
5253         end;
5254         InsertPos:=FindLineEndOrCodeAfterPosition(DestNode.StartPos);
5255         Indent:=Beauty.GetLineIndent(Src,DestNode.StartPos);
5256         //DebugLn(['MoveNodes DestNode=',GetRedefinitionNodeText(DestNode),':',DestNode.DescAsString,' DestSection=',NodeDescToStr(DestSection)]);
5257       end;
5258 
5259       // start a new section if needed
5260       //DebugLn(['MoveNodes LastInsertAtSamePos=',LastInsertAtSamePos,' NeedSection=',NodeDescToStr(NeedSection),' LastSection=',NodeDescToStr(LastSection),' DestSection=',NodeDescToStr(DestSection)]);
5261       if (LastInsertAtSamePos and (NeedSection<>LastSection))
5262       or ((not LastInsertAtSamePos) and (NeedSection<>DestSection)) then begin
5263         // start a new section
5264         case NeedSection of
5265         ctnVarSection: NewTxt:='var';
5266         ctnConstSection: NewTxt:='const';
5267         ctnResStrSection: NewTxt:='resourcestring';
5268         ctnTypeSection: NewTxt:='type';
5269         ctnLabelSection: NewTxt:='label';
5270         else NewTxt:='';
5271         end;
5272         if NewTxt<>'' then begin
5273           DebugLn(['MoveNodes start new section: insert "',NewTxt,'"']);
5274           if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
5275                                            InsertPos,InsertPos,NewTxt)
5276           then
5277             exit;
5278           Indent:=Beauty.Indent;
5279         end;
5280       end;
5281 
5282       // insert node
5283       if Node.Desc=ctnVarDefinition then begin
5284         NewTxt:=GetIdentifier(@Src[Node.StartPos]);
5285         MoveCursorToNodeStart(GetLastVarDefSequenceNode(Node));
5286         ReadNextAtom;
5287         AtomIsIdentifierE;
5288         ReadNextAtom;
5289         if not AtomIsChar(':') then RaiseCharExpectedButAtomFound(20170421201657,':');
5290         FromPos:=CurPos.StartPos;
5291         ToPos:=Node.EndPos;
5292         NewTxt:=NewTxt+ExtractCode(FromPos,ToPos,[phpWithComments]);
5293       end else begin
5294         FromPos:=Node.StartPos;
5295         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
5296         NewTxt:=ExtractCode(FromPos,ToPos,[phpWithComments]);
5297       end;
5298       NewTxt:=Beauty.GetIndentStr(Indent)+NewTxt;
5299       DebugLn(['MoveNodes insert "',NewTxt,'"']);
5300       if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
5301         NewTxt) then exit;
5302 
5303       // restore destination section if needed
5304       if not NextInsertAtSamePos then begin
5305         // this was the last insertion at this destination
5306         DebugLn(['MoveNodes this was the last insertion at this dest NeedSection=',NodeDescToStr(NeedSection),' DestSection=',NodeDescToStr(DestSection)]);
5307         if (DestNode.Desc in AllIdentifierDefinitions)
5308         and (NeedSection<>DestSection)
5309         and (DestSection in AllDefinitionSections) then begin
5310           // restore the section of destination
5311           case DestSection of
5312           ctnVarSection: NewTxt:='var';
5313           ctnConstSection: NewTxt:='const';
5314           ctnResStrSection: NewTxt:='resourcestring';
5315           ctnTypeSection: NewTxt:='type';
5316           ctnLabelSection: NewTxt:='label';
5317           else NewTxt:='';
5318           end;
5319           if NewTxt<>'' then begin
5320             DebugLn(['MoveNodes restore destination  section: insert "',NewTxt,'"']);
5321             if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
5322                                              InsertPos,InsertPos,NewTxt)
5323             then
5324               exit;
5325           end;
5326         end;
5327       end;
5328 
5329       LastSection:=NeedSection;
5330       LastInsertAtSamePos:=NextInsertAtSamePos;
5331       AVLNode:=NextAVLNode;
5332     end;
5333     Result:=SourceChangeCache.Apply;
5334   end;
5335 
5336   function CheckOrder(var Definitions: TAVLTree;
5337     var Graph: TCodeGraph): boolean;
5338   // sort definitions topologically in source
5339   // the Graph must be acyclic
5340   var
5341     ListOfGraphNodes: TFPList;
5342     CircleEdge: TCodeGraphEdge;
5343     i: Integer;
5344     GraphNode: TCodeGraphNode;
5345     AVLNode: TAVLTreeNode;
5346     UsedByGraphNode: TCodeGraphNode;
5347     PosGraphNode: TCodeGraphNode;
5348     PosUsedByGraphNode: TCodeGraphNode;
5349     NodeMoveEdges: TAVLTree;
5350     NewMoveEdge: TNodeMoveEdge;
5351   begin
5352     Result:=false;
5353     ListOfGraphNodes:=nil;
5354     NodeMoveEdges:=TAVLTree.Create(@CompareNodeMoveEdges);
5355     try
5356       //WriteCodeGraphDebugReport(Graph);
5357 
5358       // create a topologically sorted list
5359       CircleEdge:=Graph.GetTopologicalSortedList(ListOfGraphNodes,false,true,false);
5360       if CircleEdge<>nil then
5361         raise Exception.Create('not acyclic');
5362 
5363       { set the GraphNode.Data to those GraphNodes leaves
5364         with the lowest Node.StartPos
5365         For example:
5366           var AnArray: array[0..EndValue] of char;
5367           const EndValue = TMyInteger(1);
5368           type TMyInteger = integer;
5369         EndValue must be moved in front of AnArray
5370         and TMyInteger must be moved in front of EndValue and AnArray.
5371         The topological list gives:
5372           TMyInteger
5373           EndValue
5374           AnArray
5375         NOTE: topological order alone can not be used,
5376           because unrelated definitions will be mixed somehow.
5377       }
5378       // init the destinations
5379       for i:=0 to ListOfGraphNodes.Count-1 do begin
5380         GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
5381         //DebugLn(['CheckOrder ',GetRedefinitionNodeText(GraphNode.Node)]);
5382         GraphNode.Data:=GraphNode;
5383       end;
5384       // calculate the destinations as minimum of all dependencies
5385       for i:=ListOfGraphNodes.Count-1 downto 0 do begin
5386         GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
5387         if GraphNode.InTree<>nil then begin
5388           AVLNode:=GraphNode.InTree.FindLowest;
5389           while AVLNode<>nil do begin
5390             UsedByGraphNode:=TCodeGraphEdge(AVLNode.Data).FromNode;
5391             // for example: type TMyPointer = TMyInteger;
5392             // GraphNode.Node is TMyInteger
5393             // UsedByGraphNode.Node is TMyPointer
5394             //DebugLn(['CheckOrder GraphNode=',GetRedefinitionNodeText(GraphNode.Node),' UsedBy=',GetRedefinitionNodeText(UsedByGraphNode.Node)]);
5395             PosGraphNode:=TCodeGraphNode(GraphNode.Data);
5396             PosUsedByGraphNode:=TCodeGraphNode(UsedByGraphNode.Data);
5397             if PosGraphNode.Node.StartPos>PosUsedByGraphNode.Node.StartPos then
5398               GraphNode.Data:=PosUsedByGraphNode;
5399             AVLNode:=GraphNode.InTree.FindSuccessor(AVLNode);
5400           end;
5401         end;
5402       end;
5403       // create the list of moves
5404       // sorted for: 1. destination position,
5405       //             2. topological level,
5406       //             3. origin position in source
5407       for i:=0 to ListOfGraphNodes.Count-1 do begin
5408         GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
5409         PosGraphNode:=TCodeGraphNode(GraphNode.Data);
5410         if GraphNode<>PosGraphNode then begin
5411           DebugLn(['CheckOrder Move: ',
5412             GetRedefinitionNodeText(GraphNode.Node),' ',CleanPosToStr(GraphNode.Node.StartPos),
5413             ' TopoLvl=',GraphNode.Flags,
5414             ' in front of ',GetRedefinitionNodeText(PosGraphNode.Node),' ',CleanPosToStr(PosGraphNode.Node.StartPos)
5415             ]);
5416           NewMoveEdge:=TNodeMoveEdge.Create;
5417           NewMoveEdge.GraphNode:=GraphNode;
5418           NewMoveEdge.DestPos:=PosGraphNode.Node.StartPos;
5419           NewMoveEdge.TologicalLevel:=GraphNode.Flags;
5420           NewMoveEdge.SrcPos:=GraphNode.Node.StartPos;
5421           NodeMoveEdges.Add(NewMoveEdge);
5422         end;
5423       end;
5424 
5425       Result:=MoveNodes(NodeMoveEdges);
5426       // ToDo: maybe need UpdateGraph?
5427       if Definitions<>nil then ;
5428     finally
5429       DisposeAVLTree(NodeMoveEdges);
5430       ListOfGraphNodes.Free;
5431     end;
5432   end;
5433 
5434 var
5435   Definitions: TAVLTree;
5436   Graph: TCodeGraph;
5437 begin
5438   Result:=false;
5439   if (SourceChangeCache=nil) or (Scanner=nil) then begin
5440     DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions no scanner']);
5441     exit;
5442   end;
5443   Definitions:=nil;
5444   Graph:=nil;
5445   try
5446     // Workaround:
5447     // move the pointer types to the same type sections
5448     //if not MovePointerTypesToTargetSections(SourceChangeCache) then exit;
5449     //exit(true);
5450 
5451     if not BuildUnitDefinitionGraph(Definitions,Graph,true) then begin
5452       DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions BuildUnitDefinitionGraph failed']);
5453       exit;
5454     end;
5455     if Graph=nil then begin
5456       // no definitions found
5457       exit(true);
5458     end;
5459     SourceChangeCache.MainScanner:=Scanner;
5460     // fix cycles
5461     if not BreakCycles(Definitions,Graph) then begin
5462       DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions CheckCircles failed']);
5463       exit;
5464     end;
5465     // now the graph is acyclic and nodes can be moved
5466     if not CheckOrder(Definitions,Graph) then begin
5467       DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions CheckOrder failed']);
5468       exit;
5469     end;
5470   finally
5471     UpdateGraph(Definitions,Graph,false);
5472   end;
5473   Result:=true;
5474 end;
5475 
GatherUnitDefinitionsnull5476 function TCodeCompletionCodeTool.GatherUnitDefinitions(out
5477   TreeOfCodeTreeNodeExt: TAVLTree;
5478   OnlyInterface, ExceptionOnRedefinition: boolean): boolean;
5479 
5480   procedure RaiseRedefinition(Node1, Node2: TCodeTreeNode);
5481   begin
5482     MoveCursorToNodeStart(Node1);
5483     RaiseException(20170421201704,'redefinition found: '+GetRedefinitionNodeText(Node1)
5484       +' at '+CleanPosToStr(Node1.StartPos)
5485       +' and at '+CleanPosToStr(Node2.StartPos));
5486   end;
5487 
5488   procedure AddDefinition(Node: TCodeTreeNode);
5489   var
5490     NodeExt: TCodeTreeNodeExtension;
5491     NodeText: String;
5492   begin
5493     NodeText:=GetRedefinitionNodeText(Node);
5494     NodeExt:=FindCodeTreeNodeExt(TreeOfCodeTreeNodeExt,NodeText);
5495     if NodeExt<>nil then begin
5496       if NodeIsForwardProc(NodeExt.Node)
5497       and (not NodeIsForwardProc(Node)) then begin
5498         // this is the procedure body of the forward definition -> skip
5499         exit;
5500       end;
5501       if ExceptionOnRedefinition then
5502         RaiseRedefinition(NodeExt.Node,Node);
5503     end;
5504     NodeExt:=TCodeTreeNodeExtension.Create;
5505     NodeExt.Txt:=NodeText;
5506     TreeOfCodeTreeNodeExt.Add(NodeExt);
5507     NodeExt.Node:=Node;
5508   end;
5509 
5510 var
5511   Node: TCodeTreeNode;
5512 begin
5513   Result:=false;
5514   TreeOfCodeTreeNodeExt:=nil;
5515   if OnlyInterface then
5516     BuildTree(lsrImplementationStart)
5517   else
5518     BuildTree(lsrInitializationStart);
5519 
5520   // find all unit identifiers (excluding sub types)
5521   TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
5522   Node:=Tree.Root;
5523   while Node<>nil do begin
5524     case Node.Desc of
5525     ctnProcedureHead, ctnParameterList, ctnInitialization, ctnFinalization,
5526     ctnBeginBlock, ctnAsmBlock:
5527       Node:=Node.NextSkipChilds;
5528     ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnEnumIdentifier,
5529     ctnGenericType:
5530       begin
5531         // add or update definition
5532         AddDefinition(Node);
5533 
5534         if (Node.Desc=ctnTypeDefinition)
5535         and (Node.FirstChild<>nil)
5536         and (Node.FirstChild.Desc=ctnEnumerationType) then
5537           Node:=Node.FirstChild
5538         else
5539           Node:=Node.NextSkipChilds;
5540       end;
5541     ctnProcedure:
5542       begin
5543         AddDefinition(Node);
5544         Node:=Node.NextSkipChilds;
5545       end;
5546     else
5547       if OnlyInterface and (Node.Desc=ctnImplementation) then
5548         break;
5549       Node:=Node.Next;
5550     end;
5551   end;
5552 
5553   Result:=true;
5554 end;
5555 
BuildUnitDefinitionGraphnull5556 function TCodeCompletionCodeTool.BuildUnitDefinitionGraph(out
5557   DefinitionsTreeOfCodeTreeNodeExt: TAVLTree; out Graph: TCodeGraph;
5558   OnlyInterface: boolean): boolean;
5559 
5560   procedure CheckRange(Node: TCodeTreeNode; FromPos, ToPos: integer);
5561   // search the range for defined identifiers
5562   // and add edges to graph
5563   var
5564     Identifier: PChar;
5565     NodeExt: TCodeTreeNodeExtension;
5566   begin
5567     if (FromPos>=ToPos) or (FromPos<1) then exit;
5568     //DebugLn(['CheckRange Range="',dbgstr(Src[FromPos..ToPos-1]),'"']);
5569     MoveCursorToCleanPos(FromPos);
5570     repeat
5571       ReadNextAtom;
5572       if (CurPos.StartPos>=ToPos) or (CurPos.StartPos>SrcLen) then break;
5573       if AtomIsIdentifier then begin
5574         Identifier:=@Src[CurPos.StartPos];
5575         NodeExt:=FindCodeTreeNodeExtWithIdentifier(
5576                                      DefinitionsTreeOfCodeTreeNodeExt,
5577                                      Identifier);
5578         if NodeExt<>nil then begin
5579           if Graph=nil then
5580             Graph:=TCodeGraph.Create;
5581           //if Graph.GetEdge(Node,NodeExt.Node,false)=nil then
5582           //  DebugLn(['CheckRange AddEdge: ',GetRedefinitionNodeText(Node),' uses ',GetRedefinitionNodeText(NodeExt.Node)]);
5583           Graph.AddEdge(Node,NodeExt.Node);
5584         end;
5585       end;
5586     until false;
5587   end;
5588 
5589   procedure CheckSubNode(Node, SubNode: TCodeTreeNode);
5590   var
5591     ProcHead: TCodeTreeNode;
5592     ParamList: TCodeTreeNode;
5593     ChildNode: TCodeTreeNode;
5594     FunctionResult: TCodeTreeNode;
5595   begin
5596     //DebugLn(['CheckSubNode ',GetRedefinitionNodeText(Node),' ',GetRedefinitionNodeText(SubNode)]);
5597     case SubNode.Desc of
5598 
5599     ctnTypeDefinition,ctnVarDefinition,ctnGenericType,ctnConstDefinition:
5600       begin
5601         ChildNode:=FindTypeNodeOfDefinition(SubNode);
5602         if ChildNode<>nil then begin
5603           CheckSubNode(Node,ChildNode);
5604         end else if SubNode.Desc=ctnConstDefinition then begin
5605           CheckRange(Node,ChildNode.StartPos,SubNode.EndPos);
5606         end;
5607       end;
5608 
5609     ctnProcedure:
5610       begin
5611         BuildSubTreeForProcHead(SubNode,FunctionResult);
5612         ProcHead:=SubNode.FirstChild;
5613         ParamList:=ProcHead.FirstChild;
5614         if ParamList<>nil then begin
5615           ChildNode:=ParamList.FirstChild;
5616           while ChildNode<>nil do begin
5617             if (ChildNode.Desc=ctnVarDefinition) and (ChildNode.FirstChild<>nil)
5618             then begin
5619               CheckRange(Node,ChildNode.FirstChild.StartPos,ChildNode.EndPos);
5620             end;
5621             ChildNode:=ChildNode.NextBrother;
5622           end;
5623         end;
5624         if FunctionResult<>nil then begin
5625           CheckRange(Node,FunctionResult.StartPos,
5626                      FunctionResult.StartPos
5627                      +GetIdentLen(@Src[FunctionResult.StartPos]));
5628         end;
5629       end;
5630 
5631     ctnClassInterface, ctnDispinterface, ctnClass, ctnObject, ctnRecordType,
5632     ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
5633     ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
5634       begin
5635         ChildNode:=SubNode.FirstChild;
5636         while (ChildNode<>nil) and (ChildNode.HasAsParent(SubNode)) do begin
5637           if ChildNode.Desc in AllIdentifierDefinitions then begin
5638             CheckSubNode(Node,ChildNode);
5639             ChildNode:=ChildNode.NextSkipChilds;
5640           end else
5641             ChildNode:=ChildNode.Next;
5642         end;
5643       end;
5644 
5645     else
5646       CheckRange(Node,SubNode.StartPos,SubNode.Parent.EndPos);
5647     end;
5648   end;
5649 
5650 var
5651   AVLNode: TAVLTreeNode;
5652   NodeExt: TCodeTreeNodeExtension;
5653   Node: TCodeTreeNode;
5654 begin
5655   Result:=false;
5656   DefinitionsTreeOfCodeTreeNodeExt:=nil;
5657   Graph:=nil;
5658   if not GatherUnitDefinitions(DefinitionsTreeOfCodeTreeNodeExt,OnlyInterface,true) then
5659   begin
5660     DebugLn(['TCodeCompletionCodeTool.BuildUnitDefinitionGraph GatherUnitDefinitions failed']);
5661     exit;
5662   end;
5663   if DefinitionsTreeOfCodeTreeNodeExt=nil then exit(true);
5664 
5665   AVLNode:=DefinitionsTreeOfCodeTreeNodeExt.FindLowest;
5666   while AVLNode<>nil do begin
5667     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5668     Node:=NodeExt.Node;
5669     CheckSubNode(Node,Node);
5670     AVLNode:=DefinitionsTreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
5671   end;
5672 
5673   Result:=true;
5674 end;
5675 
5676 procedure TCodeCompletionCodeTool.WriteCodeGraphDebugReport(Graph: TCodeGraph);
5677 
5678   function NodeToStr(Node: TCodeTreeNode): string;
5679   begin
5680     case Node.Desc of
5681     ctnProcedure:
5682       Result:=ExtractProcHead(Node,[phpInUpperCase,phpWithoutSemicolon]);
5683     ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnEnumIdentifier,
5684     ctnGenericType:
5685       Result:=ExtractDefinitionName(Node);
5686     else
5687       Result:=Node.DescAsString;
5688     end;
5689     Result:=Result+'{'+CleanPosToStr(Node.StartPos)+'}';
5690   end;
5691 
5692 var
5693   AVLNode: TAVLTreeNode;
5694   GraphNode: TCodeGraphNode;
5695   Node: TCodeTreeNode;
5696   Cnt: LongInt;
5697   EdgeAVLNode: TAVLTreeNode;
5698   Edge: TCodeGraphEdge;
5699 begin
5700   DebugLn(['TCodeCompletionCodeTool.WriteCodeGraphDebugReport ',DbgSName(Graph),
5701     ' NodeCount=',Graph.Nodes.Count,
5702     ' EdgeCount=',Graph.Edges.Count]);
5703   Graph.ConsistencyCheck;
5704   AVLNode:=Graph.Nodes.FindLowest;
5705   while AVLNode<>nil do begin
5706     GraphNode:=TCodeGraphNode(AVLNode.Data);
5707     Node:=GraphNode.Node;
5708     DebugLn(['  ',NodeToStr(Node),' needs ',GraphNode.OutTreeCount,' definitions, is used by ',GraphNode.InTreeCount,' definitions.']);
5709     if GraphNode.OutTreeCount>0 then begin
5710       DbgOut('    Needs:');
5711       EdgeAVLNode:=GraphNode.OutTree.FindLowest;
5712       Cnt:=0;
5713       while EdgeAVLNode<>nil do begin
5714         inc(Cnt);
5715         if Cnt=5 then begin
5716           DbgOut(' ...');
5717           break;
5718         end;
5719         Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
5720         DbgOut(' '+NodeToStr(Edge.ToNode.Node));
5721         EdgeAVLNode:=GraphNode.OutTree.FindSuccessor(EdgeAVLNode);
5722       end;
5723       DebugLn;
5724     end;
5725     if GraphNode.InTreeCount>0 then begin
5726       DbgOut('    Used by:');
5727       EdgeAVLNode:=GraphNode.InTree.FindLowest;
5728       Cnt:=0;
5729       while EdgeAVLNode<>nil do begin
5730         inc(Cnt);
5731         if Cnt=5 then begin
5732           DbgOut(' ...');
5733           break;
5734         end;
5735         Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
5736         DbgOut(' '+NodeToStr(Edge.FromNode.Node));
5737         EdgeAVLNode:=GraphNode.InTree.FindSuccessor(EdgeAVLNode);
5738       end;
5739       DebugLn;
5740     end;
5741     AVLNode:=Graph.Nodes.FindSuccessor(AVLNode);
5742   end;
5743 end;
5744 
FindEmptyMethodsnull5745 function TCodeCompletionCodeTool.FindEmptyMethods(CursorPos: TCodeXYPosition;
5746   const AClassName: string; const Sections: TPascalClassSections;
5747   ListOfPCodeXYPosition: TFPList; out AllEmpty: boolean): boolean;
5748 var
5749   ProcBodyNodes: TAVLTree;
5750   AVLNode: TAVLTreeNode;
5751   NodeExt: TCodeTreeNodeExtension;
5752   Caret: TCodeXYPosition;
5753   CaretP: PCodeXYPosition;
5754 begin
5755   Result:=false;
5756   ProcBodyNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
5757   try
5758     Result:=FindEmptyMethods(CursorPos,AClassName,Sections,ProcBodyNodes,AllEmpty);
5759     if Result then begin
5760       AVLNode:=ProcBodyNodes.FindLowest;
5761       while AVLNode<>nil do begin
5762         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5763         if CleanPosToCaret(NodeExt.Node.StartPos,Caret) then begin
5764           New(CaretP);
5765           CaretP^:=Caret;
5766           ListOfPCodeXYPosition.Add(CaretP);
5767         end;
5768         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5769       end;
5770     end;
5771   finally
5772     DisposeAVLTree(ProcBodyNodes);
5773   end;
5774 end;
5775 
FindEmptyMethodsnull5776 function TCodeCompletionCodeTool.FindEmptyMethods(CursorPos: TCodeXYPosition;
5777   const AClassName: string; const Sections: TPascalClassSections;
5778   CodeTreeNodeExtensions: TAVLTree;
5779   out AllEmpty: boolean): boolean;
5780 // NodeExt.Node is the body node
5781 // NodeExt.Data is the definition node
5782 var
5783   CleanCursorPos: integer;
5784   CursorNode: TCodeTreeNode;
5785   TypeSectionNode: TCodeTreeNode;
5786   ProcBodyNodes, ClassProcs: TAVLTree;
5787   AVLNode: TAVLTreeNode;
5788   NodeExt: TCodeTreeNodeExtension;
5789   NextAVLNode: TAVLTreeNode;
5790   DefAVLNode: TAVLTreeNode;
5791   DefNodeExt: TCodeTreeNodeExtension;
5792   Desc: TCodeTreeNodeDesc;
5793   Fits: Boolean;
5794   s: TPascalClassSection;
5795 
5796   procedure GatherClassProcs;
5797   begin
5798     // gather existing proc definitions in the class
5799     if ClassProcs=nil then begin
5800       ClassProcs:=GatherProcNodes(FCompletingFirstEntryNode,
5801          [phpInUpperCase,phpAddClassName],
5802          ExtractClassName(CodeCompleteClassNode,true));
5803     end;
5804   end;
5805 
5806 begin
5807   Result:=false;
5808   AllEmpty:=false;
5809   if (AClassName<>'') and (CursorPos.Y<1) then begin
5810     BuildTree(lsrInitializationStart);
5811     CursorNode:=FindClassNodeInInterface(AClassName,true,false,true);
5812     CodeCompleteClassNode:=CursorNode;
5813   end else begin
5814     BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
5815     CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
5816     CodeCompleteClassNode:=FindClassNode(CursorNode);
5817   end;
5818   if CodeCompleteClassNode=nil then begin
5819     DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods no class at ',Dbgs(CursorPos)]);
5820     exit;
5821   end;
5822   ProcBodyNodes:=nil;
5823   ClassProcs:=nil;
5824   try
5825     // gather body nodes
5826     TypeSectionNode:=CodeCompleteClassNode.GetTopMostNodeOfType(ctnTypeSection);
5827     ProcBodyNodes:=GatherProcNodes(TypeSectionNode,
5828                         [phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
5829                          ExtractClassName(CodeCompleteClassNode,true));
5830     // collect all empty bodies
5831     AVLNode:=ProcBodyNodes.FindLowest;
5832     while AVLNode<>nil do begin
5833       NextAVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5834       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5835       //DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods ',NodeExt.Txt,' ',ProcBodyIsEmpty(NodeExt.Node)]);
5836       // check if proc body is empty (no code, no comments)
5837       if ProcBodyIsEmpty(NodeExt.Node) then begin
5838         GatherClassProcs;
5839         // search the corresponding node in the class
5840         DefAVLNode:=ClassProcs.Find(NodeExt);
5841         if (DefAVLNode<>nil) then begin
5842           DefNodeExt:=TCodeTreeNodeExtension(DefAVLNode.Data);
5843           // check visibility section
5844           if (DefNodeExt.Node.Parent<>nil) then begin
5845             Desc:=DefNodeExt.Node.Parent.Desc;
5846             Fits:=false;
5847             for s:=Low(TPascalClassSection) to High(TPascalClassSection) do
5848               if (s in Sections) and (PascalClassSectionToNodeDesc[s]=Desc) then
5849                 Fits:=true;
5850             if Fits then begin
5851               // empty and right section => add to tree
5852               ProcBodyNodes.Delete(AVLNode);
5853               NodeExt.Data:=DefNodeExt.Node;
5854               CodeTreeNodeExtensions.Add(NodeExt);
5855             end;
5856           end;
5857         end;
5858       end;
5859       AVLNode:=NextAVLNode;
5860     end;
5861     AllEmpty:=ProcBodyNodes.Count=0;
5862     Result:=true;
5863   finally
5864     DisposeAVLTree(ClassProcs);
5865     DisposeAVLTree(ProcBodyNodes);
5866   end;
5867 end;
5868 
RemoveEmptyMethodsnull5869 function TCodeCompletionCodeTool.RemoveEmptyMethods(CursorPos: TCodeXYPosition;
5870   const AClassName: string; const Sections: TPascalClassSections;
5871   SourceChangeCache: TSourceChangeCache;
5872   out AllRemoved: boolean;
5873   const Attr: TProcHeadAttributes; out RemovedProcHeads: TStrings): boolean;
5874 var
5875   ProcBodyNodes: TAVLTree;
5876   AVLNode: TAVLTreeNode;
5877   NodeExt: TCodeTreeNodeExtension;
5878   FirstNodeExt: TCodeTreeNodeExtension;
5879   LastNodeExt: TCodeTreeNodeExtension;
5880   FromPos: LongInt;
5881   ToPos: LongInt;
5882   FirstGroup: Boolean;
5883   CommentEndPos: integer;
5884   CommentStartPos: integer;
5885   ProcDefNodes: TAVLTree;
5886   NextAVLNode: TAVLTreeNode;
5887   ProcHead: String;
5888 begin
5889   Result:=false;
5890   AllRemoved:=false;
5891   RemovedProcHeads:=nil;
5892   if (SourceChangeCache=nil) or (Scanner=nil) then exit;
5893   SourceChangeCache.MainScanner:=Scanner;
5894   ProcDefNodes:=nil;
5895   ProcBodyNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
5896   try
5897     Result:=FindEmptyMethods(CursorPos,AClassName,Sections,ProcBodyNodes,AllRemoved);
5898     if Result and (ProcBodyNodes<>nil) and (ProcBodyNodes.Count>0) then begin
5899       // sort the nodes for position
5900       ProcBodyNodes.OnCompare:=@CompareCodeTreeNodeExtWithPos;
5901       ProcDefNodes:=TAVLTree.Create(@CompareCodeTreeNodeExtWithPos);
5902 
5903       // delete bodies
5904       AVLNode:=ProcBodyNodes.FindLowest;
5905       FirstGroup:=true;
5906       while AVLNode<>nil do begin
5907         // gather a group of continuous proc nodes
5908         FirstNodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5909         LastNodeExt:=FirstNodeExt;
5910         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5911         while (AVLNode<>nil) do begin
5912           NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5913           if NodeExt.Node<>LastNodeExt.Node.NextBrother then break;
5914           LastNodeExt:=NodeExt;
5915           AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5916         end;
5917         // delete group
5918         FromPos:=FindLineEndOrCodeInFrontOfPosition(FirstNodeExt.Node.StartPos,true);
5919         ToPos:=FindLineEndOrCodeAfterPosition(LastNodeExt.Node.EndPos,true);
5920         {$IFDEF VerboseBug16168}
5921         debugln(['TCodeCompletionCodeTool.RemoveEmptyMethods ',dbgstr(copy(Src,FromPos,ToPos-FromPos))]);
5922         {$ENDIF}
5923         if AllRemoved and FirstGroup
5924         and FindClassMethodsComment(FromPos,CommentStartPos,CommentEndPos) then begin
5925           // all method bodies will be removed => remove the default comment too
5926           if FindNextNonSpace(Src,CommentEndPos)>=FromPos then begin
5927             // the default comment is directly in front
5928             // => remove it too
5929             FromPos:=FindLineEndOrCodeInFrontOfPosition(CommentStartPos,true);
5930           end;
5931         end;
5932         if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then
5933           exit;
5934         FirstGroup:=false;
5935       end;
5936 
5937       // create the tree of proc definitions: ProcDefNodes
5938       AVLNode:=ProcBodyNodes.FindLowest;
5939       while AVLNode<>nil do begin
5940         NextAVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5941         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5942         // remove NodeExt from ProcBodyNodes
5943         ProcBodyNodes.Delete(AVLNode);
5944         // and add it to ProcDefNodes
5945         // the definition node is the Data
5946         // Note: the class can contain errors and therefore some method bodies
5947         // refer to the same definition => skip doubles
5948         NodeExt.Node:=TCodeTreeNode(NodeExt.Data);
5949         NodeExt.Position:=NodeExt.Node.StartPos;
5950         if (NodeExt.Node<>nil) and (ProcDefNodes.Find(NodeExt)=nil) then begin
5951           ProcDefNodes.Add(NodeExt);
5952           if RemovedProcHeads=nil then
5953             RemovedProcHeads:=TStringList.Create;
5954           ProcHead:=ExtractProcHead(NodeExt.Node,Attr);
5955           RemovedProcHeads.Add(ProcHead);
5956         end else begin
5957           NodeExt.Free;
5958         end;
5959         AVLNode:=NextAVLNode;
5960       end;
5961 
5962       // delete definitions
5963       AVLNode:=ProcDefNodes.FindLowest;
5964       while AVLNode<>nil do begin
5965         // gather a group of continuous proc nodes
5966         FirstNodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5967         LastNodeExt:=FirstNodeExt;
5968         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5969         while (AVLNode<>nil) do begin
5970           NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5971           if NodeExt.Node<>LastNodeExt.Node.NextBrother then break;
5972           LastNodeExt:=NodeExt;
5973           AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5974         end;
5975         // delete group
5976         FromPos:=FindLineEndOrCodeInFrontOfPosition(FirstNodeExt.Node.StartPos,true);
5977         ToPos:=FindLineEndOrCodeAfterPosition(LastNodeExt.Node.EndPos,true);
5978         if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then
5979           exit;
5980       end;
5981     end;
5982     Result:=SourceChangeCache.Apply;
5983   finally
5984     DisposeAVLTree(ProcBodyNodes);
5985     DisposeAVLTree(ProcDefNodes);
5986   end;
5987 end;
5988 
FindAssignMethodnull5989 function TCodeCompletionCodeTool.FindAssignMethod(CursorPos: TCodeXYPosition;
5990   out ClassNode: TCodeTreeNode; out AssignDeclNode: TCodeTreeNode;
5991   var MemberNodeExts: TAVLTree; out AssignBodyNode: TCodeTreeNode;
5992   out InheritedDeclContext: TFindContext;
5993   ProcName: string): boolean;
5994 { if CursorPos is in a class declaration search for a method "Assign"
5995   and its corresponding body.
5996   If CursorPos is in a method body use this as a Assign method and return
5997   its corresponding declararion.
5998   If neither return false.
5999   Also return a tree of all variables and properties (excluding ancestors).
6000 }
6001 
6002   procedure SearchAssign(Tool: TFindDeclarationTool; Node: TCodeTreeNode;
6003     var DeclNode: TCodeTreeNode);
6004   var
6005     Child: TCodeTreeNode;
6006     CurProcName: String;
6007   begin
6008     if Node=nil then exit;
6009     Child:=Node.FirstChild;
6010     while Child<>nil do begin
6011       if Child.Desc in AllClassSections then
6012         SearchAssign(Tool,Child,DeclNode)
6013       else if Child.Desc=ctnProcedure then begin
6014         CurProcName:=Tool.ExtractProcName(Child,[]);
6015         if CompareIdentifiers(PChar(CurProcName),PChar(ProcName))=0 then begin
6016           if DeclNode<>nil then begin
6017             debugln(['WARNING: TCodeCompletionCodeTool.FindAssignMethod.SearchAssign'
6018               +' multiple ',ProcName,' methods found, using the first at ',CleanPosToStr(DeclNode.StartPos)]);
6019           end else
6020             DeclNode:=Child;
6021         end;
6022       end;
6023       Child:=Child.NextBrother;
6024     end;
6025   end;
6026 
6027   procedure GatherAssignableMembers(Node: TCodeTreeNode);
6028   var
6029     Child: TCodeTreeNode;
6030     NodeExt: TCodeTreeNodeExtension;
6031   begin
6032     if Node=nil then exit;
6033     Child:=Node.FirstChild;
6034     while Child<>nil do begin
6035       if Child.Desc in AllClassSections then
6036         GatherAssignableMembers(Child)
6037       else if (Child.Desc=ctnVarDefinition)
6038       or ((Child.Desc=ctnProperty)
6039         and (PropertyHasSpecifier(Child,'read'))
6040         and (PropertyHasSpecifier(Child,'write')))
6041       then begin
6042         // a variable or a property which is readable and writable
6043         if MemberNodeExts=nil then
6044           MemberNodeExts:=TAVLTree.Create(@CompareCodeTreeNodeExtTxtAndPos);
6045         NodeExt:=TCodeTreeNodeExtension.Create;
6046         NodeExt.Node:=Child;
6047         NodeExt.Position:=Child.StartPos;
6048         if Child.Desc=ctnVarDefinition then
6049           NodeExt.Txt:=ExtractDefinitionName(Child)
6050         else
6051           NodeExt.Txt:=ExtractPropName(Child,false);
6052         MemberNodeExts.Add(NodeExt);
6053       end;
6054 
6055       Child:=Child.NextBrother;
6056     end;
6057   end;
6058 
6059   procedure FindVarsWrittenByProperties;
6060   var
6061     AVLNode: TAVLTreeNode;
6062     NodeExt: TCodeTreeNodeExtension;
6063     WrittenNodeExt: TCodeTreeNodeExtension;
6064   begin
6065     if MemberNodeExts=nil then exit;
6066     AVLNode:=MemberNodeExts.FindLowest;
6067     while AVLNode<>nil do begin
6068       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
6069       if NodeExt.Node.Desc=ctnProperty then begin
6070         if PropertyHasSpecifier(NodeExt.Node,'write') then begin
6071           ReadNextAtom;
6072           if AtomIsIdentifier then begin
6073             WrittenNodeExt:=FindCodeTreeNodeExtWithIdentifier(MemberNodeExts,
6074                                       @Src[CurPos.StartPos]);
6075             if WrittenNodeExt<>nil then
6076               WrittenNodeExt.Data:=NodeExt.Node;
6077           end;
6078         end;
6079       end;
6080       AVLNode:=MemberNodeExts.FindSuccessor(AVLNode);
6081     end;
6082   end;
6083 
6084   procedure FindInheritedAssign;
6085   var
6086     Params: TFindDeclarationParams;
6087   begin
6088     if ClassNode=nil then exit;
6089     Params:=TFindDeclarationParams.Create(Self, ClassNode);
6090     try
6091       Params.Flags:=[fdfSearchInAncestors];
6092       Params.Identifier:=PChar(ProcName);
6093       if not FindIdentifierInContext(Params) then exit;
6094       //debugln(['FindInheritedAssign NewNode=',Params.NewNode.DescAsString]);
6095       if Params.NewNode=nil then exit;
6096       if Params.NewNode.Desc<>ctnProcedure then exit;
6097       InheritedDeclContext:=CreateFindContext(Params);
6098     finally
6099       Params.Free;
6100     end;
6101   end;
6102 
6103 var
6104   CleanPos: integer;
6105   CursorNode: TCodeTreeNode;
6106   Node: TCodeTreeNode;
6107 begin
6108   Result:=false;
6109   ClassNode:=nil;
6110   AssignDeclNode:=nil;
6111   AssignBodyNode:=nil;
6112   InheritedDeclContext:=CleanFindContext;
6113   BuildTreeAndGetCleanPos(CursorPos,CleanPos);
6114   if ProcName='' then ProcName:='Assign';
6115   // check context
6116   CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
6117   Node:=CursorNode;
6118   while (Node<>nil) do begin
6119     if (Node.Desc=ctnProcedure) then begin
6120       if NodeIsMethodBody(Node) then begin
6121         // cursor in method body
6122         AssignBodyNode:=Node;
6123         Result:=true;
6124         AssignDeclNode:=FindCorrespondingProcNode(AssignBodyNode);
6125         if AssignDeclNode<>nil then
6126           ClassNode:=FindClassOrInterfaceNode(AssignDeclNode.Parent);
6127         break;
6128       end;
6129     end else if (Node.Desc in AllClassObjects) then begin
6130       // cursor in class/record
6131       Result:=true;
6132       ClassNode:=Node;
6133       SearchAssign(Self,ClassNode,AssignDeclNode);
6134       if AssignDeclNode<>nil then
6135         AssignBodyNode:=FindCorrespondingProcNode(AssignDeclNode);
6136       break;
6137     end;
6138     Node:=Node.Parent;
6139   end;
6140   if ClassNode=nil then exit;
6141   GatherAssignableMembers(ClassNode);
6142   FindVarsWrittenByProperties;
6143   FindInheritedAssign;
6144 end;
6145 
AddAssignMethodnull6146 function TCodeCompletionCodeTool.AddAssignMethod(ClassNode: TCodeTreeNode;
6147   MemberNodeExts: TFPList; const ProcName, ParamName, ParamType: string;
6148   OverrideMod, CallInherited, CallInheritedOnlyInElse: boolean;
6149   SourceChanger: TSourceChangeCache; out NewPos: TCodeXYPosition; out
6150   NewTopLine, BlockTopLine, BlockBottomLine: integer; LocalVarName: string
6151   ): boolean;
6152 var
6153   NodeExt: TCodeTreeNodeExtension;
6154   CleanDef: String;
6155   Def: String;
6156   aClassName: String;
6157   ProcBody: String;
6158   e: String;
6159   SameType: boolean;
6160   Indent: Integer;
6161   IndentStep: LongInt;
6162   SrcVar: String;
6163   i: Integer;
6164   Beauty: TBeautifyCodeOptions;
6165   {$IFDEF EnableCodeCompleteTemplates}
6166   NodeExtsStr: String;
6167   {$ENDIF}
6168 begin
6169   Result:=false;
6170   NewPos:=CleanCodeXYPosition;
6171   NewTopLine:=-1;
6172   if ClassNode=nil then exit;
6173   if (ParamName='') or (ParamType='') then exit;
6174   Beauty:=SourceChanger.BeautifyCodeOptions;
6175   aClassName:=ExtractClassName(ClassNode,false);
6176   CleanDef:=ProcName+'('+ParamType+');';
6177   {$IFDEF EnableCodeCompleteTemplates}
6178   if assigned(CTTemplateExpander)
6179   and CTTemplateExpander.TemplateExists('AssignMethodDef') then
6180   begin
6181     Def := CTTemplateExpander.Expand('AssignMethodDef', '','', // Doesn't use linebreak or indentation
6182                      ['ProcName',  'ParamName',  'ParamType', 'Override' ],
6183                      [ ProcName,    ParamName,    ParamType,   OverrideMod ] );
6184   end else
6185   {$ENDIF EnableCodeCompleteTemplates}
6186   begin
6187     Def:='procedure '+ProcName+'('+ParamName+':'+ParamType+');';
6188     if OverrideMod then Def:=Def+'override;';
6189   end;
6190   SrcVar:=ParamName;
6191   // create the proc header
6192   SameType:=CompareIdentifiers(PChar(aClassName),PChar(ParamType))=0;
6193   e:=SourceChanger.BeautifyCodeOptions.LineEnd;
6194   Indent:=0;
6195   IndentStep:=SourceChanger.BeautifyCodeOptions.Indent;
6196   {$IFDEF EnableCodeCompleteTemplates}
6197   if assigned(CTTemplateExpander)
6198   and CTTemplateExpander.TemplateExists('AssignMethod') then begin
6199     if not SameType then begin
6200       // add local variable
6201       SrcVar:=LocalVarName;
6202       if SrcVar='' then
6203         SrcVar:='aSource';
6204       if CompareIdentifiers(PChar(SrcVar),PChar(ParamName))=0 then begin
6205         if CompareIdentifiers(PChar(SrcVar),'aSource')=0 then
6206           SrcVar:='aSrc'
6207         else
6208           SrcVar:='aSource';
6209         end;
6210       end;
6211       // add assignments
6212       NodeExtsStr := '';
6213      if MemberNodeExts<>nil then begin
6214        for i:=0 to MemberNodeExts.Count-1 do
6215        begin
6216          NodeExt:=TCodeTreeNodeExtension(MemberNodeExts[i]);
6217          NodeExtsStr := NodeExtsStr + NodeExt.Txt + '?';
6218        end;
6219      end;
6220      ProcBody := CTTemplateExpander.Expand( 'AssignMethod',e,GetIndentStr(Indent),
6221                    ['ClassName', 'ProcName', 'ParamName',  'ParamType',
6222                      'SameType',  'SrcVar',   'Inherited0', 'Inherited1',
6223                      'NodeExt' ],
6224                     [ aClassName,  ProcName,   ParamName,    ParamType,
6225                       SameType,    SrcVar,
6226                       CallInherited and (not CallInheritedOnlyInElse),
6227                       CallInherited and CallInheritedOnlyInElse,
6228                       NodeExtsStr ] );
6229     end
6230   else
6231   {$ENDIF EnableCodeCompleteTemplates}
6232   begin
6233     ProcBody:='procedure '+aClassName+'.'+ProcName+'('+ParamName+':'+ParamType+');'+e;
6234     if not SameType then begin
6235       // add local variable
6236       SrcVar:=LocalVarName;
6237       if SrcVar='' then
6238         SrcVar:='aSource';
6239       if CompareIdentifiers(PChar(SrcVar),PChar(ParamName))=0 then begin
6240         if CompareIdentifiers(PChar(SrcVar),'aSource')=0 then
6241           SrcVar:='aSrc'
6242         else
6243           SrcVar:='aSource';
6244       end;
6245       ProcBody:=ProcBody+'var'+e
6246          +Beauty.GetIndentStr(Indent+IndentStep)+SrcVar+':'+aClassName+';'+e;
6247     end;
6248     ProcBody:=ProcBody+'begin'+e;
6249     inc(Indent,IndentStep);
6250 
6251     // call inherited
6252     if CallInherited and (not CallInheritedOnlyInElse) then
6253       ProcBody:=ProcBody
6254         +Beauty.GetIndentStr(Indent)+'inherited '+ProcName+'('+ParamName+');'+e;
6255 
6256     if not SameType then begin
6257       // add a parameter check to the new procedure
6258       ProcBody:=ProcBody
6259           +Beauty.GetIndentStr(Indent)+'if '+ParamName+' is '+aClassName+' then'+e
6260           +Beauty.GetIndentStr(Indent)+'begin'+e;
6261       inc(Indent,IndentStep);
6262       ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+SrcVar+':='+aClassName+'('+ParamName+');'+e;
6263     end;
6264 
6265     // add assignments
6266     if MemberNodeExts<>nil then begin
6267       for i:=0 to MemberNodeExts.Count-1 do begin
6268         NodeExt:=TCodeTreeNodeExtension(MemberNodeExts[i]);
6269         // add assignment
6270         ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+NodeExt.Txt+':='+SrcVar+'.'+NodeExt.Txt+';'+e;
6271       end;
6272     end;
6273 
6274     if not SameType then begin
6275       // close if block
6276       dec(Indent,IndentStep);
6277       if CallInherited and CallInheritedOnlyInElse then begin
6278         ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+'end else'+e
6279             +Beauty.GetIndentStr(Indent+IndentStep)+'inherited '+ProcName+'('+ParamName+');'+e;
6280       end else begin
6281         ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+'end;'+e
6282       end;
6283     end;
6284     // close procedure body
6285     ProcBody:=ProcBody+'end;';
6286   end;
6287 
6288   if not InitClassCompletion(ClassNode,SourceChanger) then exit;
6289   ProcBody:=SourceChanger.BeautifyCodeOptions.BeautifyStatement(ProcBody,0);
6290   AddClassInsertion(CleanDef,Def,ProcName,ncpPublicProcs,nil,ProcBody);
6291   Result:=ApplyChangesAndJumpToFirstNewProc(ClassNode.StartPos,1,true,
6292                    NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
6293 end;
6294 
TCodeCompletionCodeTool.AddAssignMethodnull6295 function TCodeCompletionCodeTool.AddAssignMethod(ClassNode: TCodeTreeNode;
6296   MemberNodeExts: TFPList; const ProcName, ParamName, ParamType: string;
6297   OverrideMod, CallInherited, CallInheritedOnlyInElse: boolean;
6298   SourceChanger: TSourceChangeCache; out NewPos: TCodeXYPosition; out
6299   NewTopLine: integer; LocalVarName: string): boolean;
6300 var
6301   BlockTopLine, BlockBottomLine: integer;
6302 begin
6303   Result := AddAssignMethod(ClassNode, MemberNodeExts, ProcName, ParamName, ParamType,
6304     OverrideMod, CallInherited, CallInheritedOnlyInElse, SourceChanger, NewPos, NewTopLine,
6305     BlockTopLine, BlockBottomLine, LocalVarName);
6306 end;
6307 
TCodeCompletionCodeTool.GetPossibleInitsForVariablenull6308 function TCodeCompletionCodeTool.GetPossibleInitsForVariable(
6309   CursorPos: TCodeXYPosition; out Statements: TStrings; out
6310   InsertPositions: TObjectList; SourceChangeCache: TSourceChangeCache): boolean;
6311 var
6312   Identifier: PChar;
6313 
6314   procedure AddStatement(aStatement: string);
6315   begin
6316     if SourceChangeCache<>nil then begin
6317       SourceChangeCache.MainScanner:=Scanner;
6318       SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(aStatement,0);
6319     end;
6320     {$IFDEF VerboseGetPossibleInitsForVariable}
6321     debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable.AddStatement "',aStatement,'"']);
6322     {$ENDIF}
6323     Statements.Add(aStatement);
6324   end;
6325 
6326   procedure AddAssignment(const aValue: string);
6327   begin
6328     AddStatement(GetIdentifier(Identifier)+':='+aValue+';');
6329   end;
6330 
6331 var
6332   CleanCursorPos: integer;
6333   CursorNode: TCodeTreeNode;
6334   IdentAtom: TAtomPosition;
6335   Params: TFindDeclarationParams;
6336   VarTool: TFindDeclarationTool;
6337   VarNode: TCodeTreeNode;
6338   ExprType: TExpressionType;
6339   BeginNode: TCodeTreeNode;
6340   InsertPosDesc: TInsertStatementPosDescription;
6341   Node: TCodeTreeNode;
6342   Tool: TFindDeclarationTool;
6343   aContext: TFindContext;
6344   FuncNode: TCodeTreeNode;
6345 begin
6346   {$IFDEF VerboseGetPossibleInitsForVariable}
6347   debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable ',dbgs(CursorPos)]);
6348   {$ENDIF}
6349   Result:=false;
6350   Statements:=TStringList.Create;
6351   InsertPositions:=TObjectList.create(true);
6352   BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
6353 
6354   // find variable name
6355   GetIdentStartEndAtPosition(Src,CleanCursorPos,
6356     IdentAtom.StartPos,IdentAtom.EndPos);
6357   {$IFDEF VerboseGetPossibleInitsForVariable}
6358   debugln('TCodeCompletionCodeTool.GetPossibleInitsForLocalVar IdentAtom="',dbgstr(Src,IdentAtom.StartPos,IdentAtom.EndPos-IdentAtom.StartPos),'"');
6359   {$ENDIF}
6360   if IdentAtom.StartPos=IdentAtom.EndPos then exit;
6361 
6362   // find context
6363   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6364 
6365   // find declaration of identifier
6366   VarTool:=nil;
6367   VarNode:=nil;
6368   Identifier:=@Src[IdentAtom.StartPos];
6369   if (cmsResult in FLastCompilerModeSwitches)
6370   and (CompareIdentifiers(Identifier,'Result')=0) then begin
6371     FuncNode:=CursorNode;
uncNodenull6372     while not NodeIsFunction(FuncNode) do
6373       FuncNode:=FuncNode.Parent;
6374     VarTool:=Self;
6375     VarNode:=FuncNode;
6376     Result:=true;
6377   end;
6378   if VarNode=nil then begin
6379     Params:=TFindDeclarationParams.Create(Self, CursorNode);
6380     try
6381       Params.SetIdentifier(Self,Identifier,nil);
6382       Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
6383                      fdfTopLvlResolving,fdfFindVariable];
6384       Result:=FindIdentifierInContext(Params);
6385       VarTool:=Params.NewCodeTool;
6386       VarNode:=Params.NewNode;
6387       if (not Result) or (VarNode=nil) then begin
6388         {$IFDEF VerboseGetPossibleInitsForVariable}
6389         debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable FindIdentifierInContext Result=',Result,' VarTool=',VarTool<>nil,' VarNode=',VarNode<>nil]);
6390         {$ENDIF}
6391         MoveCursorToAtomPos(IdentAtom);
6392         RaiseException(20170421201708,'failed to resolve identifier "'+Identifier+'"');
6393       end;
6394       {$IFDEF VerboseGetPossibleInitsForVariable}
6395       debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable FindIdentifierInContext VarTool=',ExtractFilename(VarTool.MainFilename),' VarNode=',VarNode.DescAsString]);
6396       {$ENDIF}
6397     finally
6398       Params.Free;
6399     end;
6400   end;
6401 
6402   // resolve type
6403   Params:=TFindDeclarationParams.Create(Self, CursorNode);
6404   try
6405     Params.Flags:=fdfDefaultForExpressions;
6406     if VarNode.Desc in [ctnProcedure,ctnProcedureHead] then
6407       Params.Flags:=Params.Flags+[fdfFunctionResult];
6408     ExprType:=VarTool.ConvertNodeToExpressionType(VarNode,Params);
6409     {$IFDEF VerboseGetPossibleInitsForVariable}
6410     DebugLn('TCodeCompletionCodeTool.GetPossibleInitsForVariable ConvertNodeToExpressionType',
6411       ' Expr=',ExprTypeToString(ExprType));
6412     {$ENDIF}
6413   finally
6414     Params.Free;
6415   end;
6416 
6417   case ExprType.Desc of
6418   xtContext:
6419     begin
6420       // ToDo: ranges, records, objects, pointer, class, class of, interface
6421       Node:=ExprType.Context.Node;
6422       Tool:=ExprType.Context.Tool;
6423       case Node.Desc of
6424       ctnEnumerationType:
6425         begin
6426           // enumeration: add first 10 enums
6427           Node:=Node.FirstChild;
6428           while (Node<>nil) and (Statements.Count<10) do begin
6429             if Node.Desc=ctnEnumIdentifier then
6430               AddAssignment(GetIdentifier(@Tool.Src[Node.StartPos]));
6431             Node:=Node.NextBrother;
6432           end;
6433         end;
6434       ctnSetType:
6435         // set of
6436         AddAssignment('[]');
6437       ctnClass,ctnClassInterface,ctnDispinterface,
6438       ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,ctnCPPClass:
6439         AddAssignment('nil');
6440       ctnPointerType:
6441         AddAssignment('nil');
6442       ctnProcedureType,ctnReferenceTo:
6443         // address of proc
6444         AddAssignment('nil');
6445       ctnProcedureHead:
odenull6446         if Tool.NodeIsFunction(Node) then begin
6447           Params:=TFindDeclarationParams.Create(Tool, Node);
6448           try
6449             aContext:=Tool.FindBaseTypeOfNode(Params,Node);
6450             Tool:=aContext.Tool;
6451             Node:=aContext.Node;
6452           finally
6453             Params.Free;
6454           end;
6455         end;
6456       end;
6457     end;
6458   xtChar,
6459   xtWideChar: begin AddAssignment('#0'); AddAssignment(''' '''); end;
6460   xtReal,
6461   xtSingle,
6462   xtDouble,
6463   xtExtended,
6464   xtCExtended: begin AddAssignment('0.0'); AddAssignment('1.0'); end;
6465   xtCurrency: AddAssignment('0.00');
6466   xtComp,
6467   xtInt64,
6468   xtCardinal,
6469   xtQWord: AddAssignment('0');
6470   xtBoolean,
6471   xtByteBool,
6472   xtWordBool,
6473   xtLongBool,
6474   xtQWordBool: begin AddAssignment('False'); AddAssignment('True'); end;
6475   xtString,
6476   xtAnsiString,
6477   xtShortString,
6478   xtWideString,
6479   xtUnicodeString: AddAssignment('''''');
6480   xtPChar: begin AddAssignment('nil'); AddAssignment('#0'); end;
6481   xtPointer: AddAssignment('nil');
6482   xtConstOrdInteger: AddAssignment('0');
6483   xtConstString: AddAssignment('''''');
6484   xtConstReal: AddAssignment('0.0');
6485   xtConstSet: AddAssignment('[]');
6486   xtConstBoolean: begin AddAssignment('False'); AddAssignment('True'); end;
6487   xtLongint,
6488   xtLongWord,
6489   xtWord,
6490   xtSmallInt,
6491   xtShortInt,
6492   xtByte,
6493   xtNativeInt,
6494   xtNativeUInt: AddAssignment('0');
6495   xtVariant: begin AddAssignment('0'); AddAssignment(''''''); end;
6496   xtJSValue: begin AddAssignment('0'); AddAssignment(''''''); AddAssignment('nil'); AddAssignment('false'); end;
6497   end;
6498   if Statements.Count=0 then begin
6499     MoveCursorToAtomPos(IdentAtom);
6500     RaiseException(20170421201711,'auto initialize not yet implemented for identifier "'+GetIdentifier(Identifier)+'" of type "'+ExprTypeToString(ExprType)+'"');
6501   end;
6502 
6503   // find possible insert positions
6504   BeginNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
6505   if BeginNode<>nil then begin
6506     InsertPosDesc:=TInsertStatementPosDescription.Create;
6507     InsertPosDesc.InsertPos:=BeginNode.StartPos+length('begin');
6508     CleanPosToCaret(InsertPosDesc.InsertPos,InsertPosDesc.CodeXYPos);
6509     InsertPosDesc.Indent:=GetLineIndent(Src,BeginNode.StartPos);
6510     if SourceChangeCache<>nil then
6511       inc(InsertPosDesc.Indent,SourceChangeCache.BeautifyCodeOptions.Indent)
6512     else
6513       inc(InsertPosDesc.Indent,2);
6514     InsertPosDesc.FrontGap:=gtNewLine;
6515     InsertPosDesc.AfterGap:=gtNewLine;
6516     InsertPosDesc.Description:='After BEGIN keyword';
6517     if (BeginNode.Parent<>nil) then begin
6518       if BeginNode.Parent.Desc=ctnProcedure then
6519         InsertPosDesc.Description+=' of '
6520           +ExtractProcHead(BeginNode.Parent,[phpWithStart,phpAddClassName,phpWithoutParamList]);
6521     end;
6522     InsertPositions.Add(InsertPosDesc);
6523   end;
6524 
6525   if InsertPositions.Count=0 then begin
6526     MoveCursorToAtomPos(IdentAtom);
6527     RaiseException(20170421201714,'auto initialize not yet implemented for this context (Node='+CursorNode.DescAsString+')');
6528   end;
6529 end;
6530 
GuessTypeOfIdentifiernull6531 function TCodeCompletionCodeTool.GuessTypeOfIdentifier(
6532   CursorPos: TCodeXYPosition; out IsKeyword, IsSubIdentifier: boolean;
6533   out ExistingDefinition: TFindContext; out ListOfPFindContext: TFPList;
6534   out NewExprType: TExpressionType; out NewType: string): boolean;
6535 { examples:
6536    identifier:=<something>
6537    aclass.identifier:=<something>
6538    <something>:=aclass.identifier
6539    <something>:=<something>+aclass.identifier
6540    for identifier in <something>
6541    ToDo: <proc>(,,aclass.identifier)
6542 
6543  checks where the identifier is already defined or is a keyword
6544  checks if the identifier is a sub identifier (e.g. A.identifier)
6545  creates the list of possible insert locations
6546  checks if it is the target of an assignment and guesses the type
6547  checks if it is the run variable of an for in and guesses the type
6548  ToDo: checks if it is a parameter and guesses the type
6549 }
6550 var
6551   CleanCursorPos: integer;
6552   Params: TFindDeclarationParams;
6553   CursorNode: TCodeTreeNode;
6554   IdentifierAtom: TAtomPosition;
6555   TermAtom: TAtomPosition;
6556   i: Integer;
6557   Context: PFindContext;
6558   Section: TCodeTreeNode;
6559   ExistingNodeInProc: Boolean;
6560   Keep: Boolean;
6561   InAtomEndPos: Integer;
6562 begin
6563   Result:=false;
6564   IsKeyword:=false;
6565   IsSubIdentifier:=false;
6566   ExistingDefinition:=CleanFindContext;
6567   ListOfPFindContext:=nil;
6568   NewExprType:=CleanExpressionType;
6569   NewType:='';
6570   BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
6571   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6572 
6573   // find identifier name
6574   GetIdentStartEndAtPosition(Src,CleanCursorPos,
6575     IdentifierAtom.StartPos,IdentifierAtom.EndPos);
6576   {$IFDEF VerboseGuessTypeOfIdentifier}
6577   debugln('TCodeCompletionCodeTool.GuessTypeOfIdentifier A Atom=',GetAtom(IdentifierAtom),' "',dbgstr(Src,CleanCursorPos,10),'"');
6578   {$ENDIF}
6579   if IdentifierAtom.StartPos=IdentifierAtom.EndPos then exit;
6580   Result:=true;
6581 
6582   MoveCursorToAtomPos(IdentifierAtom);
6583   if AtomIsKeyWord then begin
6584     {$IFDEF VerboseGuessTypeOfIdentifier}
6585     debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier is keyword: ',GetAtom]);
6586     {$ENDIF}
6587     IsKeyword:=true;
6588     exit;
6589   end;
6590 
6591   // search identifier
6592   ActivateGlobalWriteLock;
6593   try
6594     Params:=TFindDeclarationParams.Create(Self, CursorNode);
6595     try
6596       {$IF defined(CTDEBUG) or defined(VerboseGuessTypeOfIdentifier)}
6597       DebugLn('  GuessTypeOfIdentifier: check if variable is already defined ...');
6598       {$ENDIF}
6599       // check if identifier exists
6600       Result:=IdentifierIsDefined(IdentifierAtom,CursorNode,Params);
6601       if Result then begin
6602         // identifier is already defined
6603         ExistingDefinition.Tool:=Params.NewCodeTool;
6604         ExistingDefinition.Node:=Params.NewNode;
6605         {$IFDEF VerboseGuessTypeOfIdentifier}
6606         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier identifier already defined at ',FindContextToString(ExistingDefinition)]);
6607         {$ENDIF}
6608       end;
6609     finally
6610       Params.Free;
6611     end;
6612 
6613     // find all possible contexts
6614     if not FindIdentifierContextsAtStatement(IdentifierAtom.StartPos,
6615       IsSubIdentifier,ListOfPFindContext)
6616     then begin
6617       {$IFDEF VerboseGuessTypeOfIdentifier}
6618       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier FindIdentifierContextsAtStatement failed']);
6619       {$ENDIF}
6620       exit;
6621     end;
6622 
6623     // remove contexts conflicting with the already defined identifier
6624     if (ExistingDefinition.Node<>nil) and (ListOfPFindContext<>nil) then begin
6625       Section:=ExistingDefinition.Node;
6626       while Section<>nil do begin
6627         if Section.Desc in AllDefinitionSections then break;
6628         Section:=Section.Parent;
6629       end;
6630       ExistingNodeInProc:=ExistingDefinition.Node.HasParentOfType(ctnProcedure);
6631       if Section<>nil then begin
6632         for i:=ListOfPFindContext.Count-1 downto 0 do begin
6633           Context:=PFindContext(ListOfPFindContext[i]);
6634           Keep:=true;
6635           if ExistingNodeInProc then begin
6636             if (Context^.Tool<>ExistingDefinition.Tool)
6637             or (Context^.Node.StartPos<=ExistingDefinition.Node.StartPos) then
6638               Keep:=false; // existing is local var => delete all outside
6639           end;
6640 
6641           if Keep
6642           and (Context^.Tool=ExistingDefinition.Tool)
6643           and (((ExistingDefinition.Node=Context^.Node)
6644               or ExistingDefinition.Node.HasAsParent(Context^.Node)))
6645           then begin
6646             // context is outside or same as existing context
6647             // (e.g. identifier is already defined in the class) => delete
6648             Keep:=false;
6649           end;
6650           if Keep then continue;
6651           Dispose(Context);
6652           ListOfPFindContext.Delete(i);
6653         end;
6654       end;
6655     end;
6656 
6657     // find assignment operator :=
6658     MoveCursorToAtomPos(IdentifierAtom);
6659     ReadNextAtom;
6660     if AtomIs(':=') then begin
6661       // is assignment
6662       //AssignmentOperator:=CurPos;
6663 
6664       // find term
6665       ReadNextAtom;
6666       TermAtom.StartPos:=CurPos.StartPos;
6667       TermAtom.EndPos:=FindEndOfExpression(TermAtom.StartPos);
6668       if TermAtom.StartPos=TermAtom.EndPos then begin
6669         {$IFDEF VerboseGuessTypeOfIdentifier}
6670         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier nothing behind := operator']);
6671         {$ENDIF}
6672         exit;
6673       end;
6674       {$IFDEF VerboseGuessTypeOfIdentifier}
6675       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier guessing type of assignment :="',dbgstr(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"']);
6676       {$ENDIF}
6677 
6678       // find type of term
6679       Params:=TFindDeclarationParams.Create(Self, CursorNode);
6680       try
6681         NewType:=FindTermTypeAsString(TermAtom,Params,NewExprType);
6682       finally
6683         Params.Free;
6684       end;
6685       {$IFDEF VerboseGuessTypeOfIdentifier}
6686       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier Assignment type=',NewType]);
6687       {$ENDIF}
6688       Result:=true;
6689     end;
6690 
6691     if not Result then begin
6692       MoveCursorToAtomPos(IdentifierAtom);
6693       // find 'in' operator
6694       ReadNextAtom;
6695       if UpAtomIs('IN') then begin
6696         InAtomEndPos:=CurPos.EndPos;
6697 
6698         // find 'for' keyword
6699         MoveCursorToCleanPos(IdentifierAtom.StartPos);
6700         ReadPriorAtom;
6701         if not UpAtomIs('FOR') then exit;
6702 
6703         // find term
6704         MoveCursorToCleanPos(InAtomEndPos);
6705         ReadNextAtom;
6706         TermAtom.StartPos:=CurPos.StartPos;
6707         TermAtom.EndPos:=FindEndOfExpression(TermAtom.StartPos);
6708 
6709         {$IFDEF VerboseGuessTypeOfIdentifier}
6710         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier guessing type of for-in list "',dbgstr(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"']);
6711         {$ENDIF}
6712         // find type of term
6713         Params:=TFindDeclarationParams.Create(Self, CursorNode);
6714         try
6715           NewType:=FindForInTypeAsString(TermAtom,CursorNode,Params,NewExprType);
6716         finally
6717           Params.Free;
6718         end;
6719         {$IFDEF VerboseGuessTypeOfIdentifier}
6720         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier For-In type=',NewType]);
6721         {$ENDIF}
6722         Result:=true;
6723       end;
6724     end;
6725 
6726     if not Result then begin
6727       {$IFDEF VerboseGuessTypeOfIdentifier}
6728       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier can not guess type']);
6729       {$ENDIF}
6730       exit;
6731     end;
6732 
6733   finally
6734     DeactivateGlobalWriteLock;
6735   end;
6736 end;
6737 
TCodeCompletionCodeTool.DeclareVariableNearBynull6738 function TCodeCompletionCodeTool.DeclareVariableNearBy(
6739   InsertPos: TCodeXYPosition; const VariableName, NewType, NewUnitName: string;
6740   Visibility: TCodeTreeNodeDesc; SourceChangeCache: TSourceChangeCache;
6741   LevelPos: TCodeXYPosition): boolean;
6742 var
6743   CleanCursorPos: integer;
6744   CursorNode: TCodeTreeNode;
6745   NewPos: TCodeXYPosition;
6746   NewTopLine: integer;
6747   Node: TCodeTreeNode;
6748   ClassPart: TNewClassPart;
6749   LevelCleanPos: integer;
6750 begin
6751   Result:=false;
6752   {$IFDEF CTDEBUG}
6753   debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy InsertPos=',dbgs(InsertPos),' Name="',VariableName,'" Type="',NewType,'" Unit=',NewUnitName,' LevelPos=',dbgs(LevelPos)]);
6754   {$ENDIF}
6755   BuildTreeAndGetCleanPos(InsertPos,CleanCursorPos);
6756   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6757   CaretToCleanPos(LevelPos,LevelCleanPos);
6758   if LevelCleanPos>0 then begin
6759     Node:=FindDeepestNodeAtPos(LevelCleanPos,false);
6760     while Node<>nil do begin
6761       //debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy Node=',Node.DescAsString]);
6762       if Node.Desc in AllClassObjects then begin
6763         // class member
6764         debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy class member']);
6765         // initialize class for code completion
6766         InitClassCompletion(Node,SourceChangeCache);
6767         // check if variable already exists
6768         if VarExistsInCodeCompleteClass(UpperCaseStr(VariableName)) then begin
6769           debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy member already exists: ',VariableName,' Class=',ExtractClassName(Node,false)]);
6770           exit;
6771         end;
6772         ClassPart:=ncpPublishedVars;
6773         case Visibility of
6774         ctnClassPrivate: ClassPart:=ncpPrivateVars;
6775         ctnClassProtected: ClassPart:=ncpProtectedVars;
6776         ctnClassPublic: ClassPart:=ncpPublicVars;
6777         end;
6778         AddClassInsertion(UpperCaseStr(VariableName),
6779                           VariableName+':'+NewType+';',VariableName,ClassPart);
6780         if not InsertAllNewClassParts then
6781           RaiseException(20170421201717,ctsErrorDuringInsertingNewClassParts);
6782         if (NewUnitName<>'')
6783         and (not IsHiddenUsedUnit(PChar(NewUnitName)))
6784         and (not AddUnitToMainUsesSection(NewUnitName,'',SourceChangeCache)) then
6785         begin
6786           debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy AddUnitToMainUsesSection for new class memeber failed']);
6787           exit;
6788         end;
6789         // apply the changes
6790         if not SourceChangeCache.Apply then
6791           RaiseException(20170421201720,ctsUnableToApplyChanges);
6792         exit(true);
6793       end;
6794       Node:=Node.Parent;
6795     end;
6796   end;
6797   SourceChangeCache.MainScanner:=Scanner;
6798   Node:=CursorNode;
6799   Result:=AddLocalVariable(CleanCursorPos,1,VariableName,NewType,NewUnitName,
6800                            NewPos,NewTopLine,SourceChangeCache,LevelCleanPos);
6801 end;
6802 
TCodeCompletionCodeTool.DeclareVariableAtnull6803 function TCodeCompletionCodeTool.DeclareVariableAt(CursorPos: TCodeXYPosition;
6804   const VariableName, NewType, NewUnitName: string;
6805   SourceChangeCache: TSourceChangeCache): boolean;
6806 var
6807   CleanCursorPos: integer;
6808   CursorNode: TCodeTreeNode;
6809   NewCode: String;
6810   FrontGap: TGapTyp;
6811   AfterGap: TGapTyp;
6812   InsertPos: Integer;
6813   Indent: Integer;
6814   Node: TCodeTreeNode;
6815   NeedSection: Boolean;
6816   Beauty: TBeautifyCodeOptions;
6817 begin
6818   Result:=false;
6819   {$IFDEF CTDEBUG}
6820   debugln(['TCodeCompletionCodeTool.DeclareVariableAt CursorPos=',dbgs(CursorPos),' Name="',VariableName,'" Type="',NewType,'" Unit=',NewUnitName]);
6821   {$ENDIF}
6822   BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
6823   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6824   SourceChangeCache.MainScanner:=Scanner;
6825   InsertPos:=CleanCursorPos;
6826   Indent:=0;
6827   FrontGap:=gtNewLine;
6828   AfterGap:=gtNewLine;
6829   Beauty:=SourceChangeCache.BeautifyCodeOptions;
6830   {$IFDEF CTDEBUG}
6831   debugln(['TCodeCompletionCodeTool.DeclareVariableAt CursorNode=',CursorNode.DescAsString]);
6832   {$ENDIF}
6833   NewCode:=VariableName+':'+NewType+';';
6834   NeedSection:=false;
6835   if CursorNode.Desc=ctnVarDefinition then begin
6836     // insert in front of another var
6837     CursorNode:=GetFirstGroupVarNode(CursorNode);
6838     InsertPos:=CursorNode.StartPos;
6839     Indent:=Beauty.GetLineIndent(Src,InsertPos);
6840   end else if CursorNode.Desc in (AllClassBaseSections
6841     +[ctnVarSection,ctnRecordType,ctnClassClassVar])
6842   then begin
6843     // insert into a var section
6844     if (CursorNode.FirstChild=nil)
6845     or (CursorNode.FirstChild.StartPos>InsertPos) then begin
6846       MoveCursorToNodeStart(CursorNode);
6847       ReadNextAtom;
6848       if (CurPos.EndPos<CursorNode.EndPos)
6849       and ((CursorNode.FirstChild=nil) or (CursorNode.FirstChild.StartPos>CurPos.EndPos))
6850       and (InsertPos<CurPos.EndPos) then
6851         InsertPos:=CurPos.EndPos;
6852     end;
6853     if CursorNode.FirstChild<>nil then
6854       Indent:=Beauty.GetLineIndent(Src,CursorNode.FirstChild.StartPos)
6855     else
6856       Indent:=Beauty.GetLineIndent(Src,CursorNode.StartPos)+Beauty.Indent;
6857   end else if CursorNode.Desc in [ctnProcedure,ctnInterface,ctnImplementation,
6858     ctnProgram,ctnLibrary,ctnPackage]
6859   then begin
6860     Node:=CursorNode.FirstChild;
6861     if (Node<>nil) and (Node.Desc=ctnSrcName) then
6862       Node:=Node.NextBrother;
6863     // make sure to insert behind uses section and proc header
6864     if (Node<>nil) and (Node.Desc in [ctnUsesSection,ctnProcedureHead]) then
6865     begin
6866       if (Node<>nil) and (InsertPos<Node.EndPos) then
6867         InsertPos:=Node.EndPos;
6868     end;
6869     // find node in front
6870     while (Node<>nil) and (Node.NextBrother<>nil)
6871     and (Node.NextBrother.StartPos<InsertPos) do
6872       Node:=Node.NextBrother;
6873     if (Node<>nil) and (Node.Desc=ctnVarSection) then begin
6874       // append to a var section
6875       if Node.LastChild<>nil then
6876         Indent:=Beauty.GetLineIndent(Src,Node.LastChild.StartPos)
6877       else
6878         Indent:=Beauty.GetLineIndent(Src,Node.StartPos)+Beauty.Indent;
6879     end else begin
6880       // start a new var section
6881       NeedSection:=true;
6882       if Node<>nil then
6883         Indent:=Beauty.GetLineIndent(Src,Node.StartPos)
6884       else if CursorNode.FirstChild<>nil then
6885         Indent:=Beauty.GetLineIndent(Src,CursorNode.FirstChild.StartPos)
6886       else
6887         Indent:=Beauty.GetLineIndent(Src,CursorNode.StartPos);
6888     end;
6889   end else begin
6890     // default: add the variable at cursor
6891     NeedSection:=true;
6892   end;
6893   if NeedSection then
6894     NewCode:='var'+Beauty.LineEnd+Beauty.GetIndentStr(Beauty.Indent)+NewCode;
6895   NewCode:=Beauty.BeautifyStatement(NewCode,Indent,[bcfIndentExistingLineBreaks]);
6896 
6897   SourceChangeCache.BeginUpdate;
6898   try
6899     if (NewUnitName<>'') then begin
6900       if not AddUnitToMainUsesSection(NewUnitName,'',SourceChangeCache) then begin
6901         debugln(['TCodeCompletionCodeTool.DeclareVariableAt AddUnitToMainUsesSection failed']);
6902         exit;
6903       end;
6904     end;
6905     {$IFDEF VerboseCompletionAdds}
6906     debugln(['TCodeCompletionCodeTool.DeclareVariableAt NewCode="',dbgstr(NewCode),'"']);
6907     {$ENDIF}
6908     if not SourceChangeCache.Replace(FrontGap,AfterGap,InsertPos,InsertPos,NewCode)
6909     then exit;
6910     Result:=true;
6911   finally
6912     if not Result then
6913       SourceChangeCache.Clear;
6914     if not SourceChangeCache.EndUpdate then
6915       Result:=false;
6916   end;
6917 end;
6918 
InitClassCompletionnull6919 function TCodeCompletionCodeTool.InitClassCompletion(
6920   const AClassName: string;
6921   SourceChangeCache: TSourceChangeCache): boolean;
6922 var
6923   ClassNode: TCodeTreeNode;
6924 begin
6925   Result:=false;
6926   BuildTree(lsrInitializationStart);
6927   if ScannedRange<>lsrEnd then exit;
6928   if (SourceChangeCache=nil) or (Scanner=nil) then exit;
6929   ClassNode:=FindClassNodeInUnit(AClassName,true,false,false,true);
6930   Result:=InitClassCompletion(ClassNode,SourceChangeCache);
6931 end;
6932 
InitClassCompletionnull6933 function TCodeCompletionCodeTool.InitClassCompletion(ClassNode: TCodeTreeNode;
6934   SourceChangeCache: TSourceChangeCache): boolean;
6935 begin
6936   if (ClassNode=nil) then exit(false);
6937   CodeCompleteClassNode:=ClassNode;
6938   CodeCompleteSrcChgCache:=SourceChangeCache;
6939   FreeClassInsertionList;
6940   Result:=true;
6941 end;
6942 
TCodeCompletionCodeTool.ApplyClassCompletionnull6943 function TCodeCompletionCodeTool.ApplyClassCompletion(
6944   AddMissingProcBodies: boolean): boolean;
6945 begin
6946   Result:=false;
6947   try
6948     // insert all new class parts
6949     if not InsertAllNewClassParts then
6950       RaiseException(20170421201722,ctsErrorDuringInsertingNewClassParts);
6951     // insert all missing proc bodies
6952     if AddMissingProcBodies and (not CreateMissingClassProcBodies(true)) then
6953       RaiseException(20170421201724,ctsErrorDuringCreationOfNewProcBodies);
6954     // apply the changes
6955     if not CodeCompleteSrcChgCache.Apply then
6956       RaiseException(20170421201726,ctsUnableToApplyChanges);
6957     Result:=true;
6958   finally
6959     FreeClassInsertionList;
6960   end;
6961 end;
6962 
CompletePropertynull6963 function TCodeCompletionCodeTool.CompleteProperty(
6964   PropNode: TCodeTreeNode): boolean;
6965 {
6966  examples:
6967    property Visible;
6968    property Count: integer;
6969    property Color: TColor read FColor write SetColor;
6970    property Items[Index1, Index2: integer]: integer read GetItems; default;
6971    property X: integer index 1 read GetCoords write SetCoords stored IsStored;
6972    property C: char read GetC stored False default 'A';
6973    property Col8: ICol8 read FCol8 write FCol8 implements ICol8, IColor;
6974    property Visible: WordBool readonly dispid 401;
6975 
6976    property specifiers without parameters:
6977      ;nodefault, ;default
6978 
6979    property specifiers with parameters:
6980      index <id or number>, read <id>, write <id>, stored <id>,
6981      default <constant>, implements <id>[,<id>...]
6982 }
6983 type
6984   TPropPart = (ppName,       // property name
6985                ppParamList,  // param list
6986                ppType,       // type identifier
6987                ppIndexWord,  // 'index'
6988                ppIndex,      // index constant
6989                ppReadWord,   // 'read'
6990                ppRead,       // read identifier
6991                ppWriteWord,  // 'write'
6992                ppWrite,      // write identifier
6993                ppStoredWord, // 'stored'
6994                ppStored,     // stored identifier
6995                ppImplementsWord,// 'implements'
6996                ppImplements, // implements identifier
6997                ppDefaultWord,// 'default'  (the default value keyword,
6998                              //             not the default property)
6999                ppDefault,    // default constant
7000                ppNoDefaultWord,// 'nodefault'
7001                ppDispidWord, // 'dispid'
7002                ppDispid      // dispid constant
7003                );
7004 
7005 var
7006   Parts: array[TPropPart] of TAtomPosition;
7007   PartIsAtom: array[TPropPart] of boolean; // is single identifier
7008 
7009   procedure ReadSimpleSpec(SpecWord, SpecParam: TPropPart);
7010   // allowed after simple specifier like 'read':
7011   //   one semicolon
7012   //   or an <identifier>
7013   //   or an <identifier>.<identifier>
7014   //   (only read, write: ) or an <identifier>[ordinal expression]
7015   //   or a specifier
7016   begin
7017     if Parts[SpecWord].StartPos>=1 then
7018       RaiseExceptionFmt(20170421201731,ctsPropertySpecifierAlreadyDefined,[GetAtom]);
7019     Parts[SpecWord]:=CurPos;
7020     ReadNextAtom;
7021     if AtomIsChar(';') then exit;
7022     AtomIsIdentifierE;
7023     if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7024       CurPos.EndPos-CurPos.StartPos)
7025     then
7026       exit;
7027     Parts[SpecParam]:=CurPos;
7028     ReadNextAtom;
7029     while CurPos.Flag=cafPoint do begin
7030       ReadNextAtom;
7031       AtomIsIdentifierE;
7032       ReadNextAtom;
7033       PartIsAtom[SpecParam]:=false;
7034       Parts[SpecParam].EndPos:=CurPos.EndPos;
7035     end;
7036     if (SpecParam in [ppRead,ppWrite])
7037     and (CurPos.Flag=cafEdgedBracketOpen) then begin
7038       // array access
7039       PartIsAtom[SpecParam]:=false;
7040       ReadTilBracketClose(true);
7041       ReadNextAtom;
7042     end;
7043   end;
7044 
7045 var
7046   CleanAccessFunc, CleanParamList, ParamList, PropName, PropType, VariableName: string;
7047   IsClassProp: boolean;
7048   InsertPos: integer;
7049   BeautifyCodeOpts: TBeautifyCodeOptions;
7050   IndexType: string;
7051 
7052   procedure InitCompleteProperty;
7053   var APart: TPropPart;
7054   begin
7055     for APart:=Low(TPropPart) to High(TPropPart) do begin
7056       Parts[APart].StartPos:=-1;
7057       PartIsAtom[APart]:=true;
7058     end;
7059     IndexType:='Integer';
7060   end;
7061 
7062   procedure ReadPropertyKeywordAndName;
7063   begin
7064     MoveCursorToNodeStart(PropNode);
7065     ReadNextAtom; // read 'property'
7066     IsClassProp:=false;
7067     if UpAtomIs('CLASS') then begin
7068       IsClassProp:=true;
7069       ReadNextAtom;
7070     end;
7071     ReadNextAtom; // read name
7072     Parts[ppName]:=CurPos;
7073     PropName := copy(Src,Parts[ppName].StartPos,
7074       Parts[ppName].EndPos-Parts[ppName].StartPos);
7075     if (PropName <> '') and (PropName[1] = '&') then//property name starts with '&'
7076       Delete(PropName, 1, 1);
7077     ReadNextAtom;
7078   end;
7079 
7080   procedure ReadPropertyParamList;
7081   begin
7082     if AtomIsChar('[') then begin
7083       // read parameter list '[ ... ]'
7084       Parts[ppParamList].StartPos:=CurPos.StartPos;
7085       InitExtraction;
7086       if not ReadParamList(true,true,[phpInUpperCase,phpWithoutBrackets])
7087       then begin
7088         {$IFDEF CTDEBUG}
7089         DebugLn('[TCodeCompletionCodeTool.CompleteProperty] error parsing param list');
7090         {$ENDIF}
7091         RaiseException(20170421201733,ctsErrorInParamList);
7092       end;
7093       CleanParamList:=GetExtraction(true);
7094       Parts[ppParamList].EndPos:=CurPos.EndPos;
7095     end else
7096       CleanParamList:='';
7097   end;
7098 
ReadPropertyTypenull7099   function ReadPropertyType: string;
7100 
7101     procedure CheckIdentifier;
7102     begin
7103       if (CurPos.StartPos>PropNode.EndPos)
7104       or UpAtomIs('END') or AtomIsChar(';') or (not AtomIsIdentifier)
7105       or AtomIsKeyWord then begin
7106         // no type name found -> ignore this property
7107         RaiseExceptionFmt(20170421201735,ctsPropertTypeExpectedButAtomFound,[GetAtom]);
7108       end;
7109     end;
7110 
7111   var
7112     p: Integer;
7113   begin
7114     ReadNextAtom; // read type
7115     CheckIdentifier;
7116     Parts[ppType]:=CurPos;
7117     Result:=GetAtom;
7118     ReadTypeReference(false);
7119     p:=LastAtoms.GetPriorAtom.EndPos;
7120     if p>Parts[ppType].EndPos then begin
7121       Parts[ppType].EndPos:=p;
7122       Result:=ExtractCode(Parts[ppType].StartPos,Parts[ppType].EndPos,[]);
7123     end;
7124   end;
7125 
7126   procedure ReadIndexSpecifier;
7127   var
7128     Last: TAtomPosition;
7129   begin
7130     if UpAtomIs('INDEX') then begin
7131       if Parts[ppIndexWord].StartPos>=1 then
7132         RaiseException(20170421201737,ctsIndexSpecifierRedefined);
7133       Parts[ppIndexWord]:=CurPos;
7134       ReadNextAtom;
7135       if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7136         CurPos.EndPos-CurPos.StartPos) then
7137         RaiseExceptionFmt(20170421201740,ctsIndexParameterExpectedButAtomFound,[GetAtom]);
7138       Parts[ppIndex].StartPos:=CurPos.StartPos;
7139       ReadConstant(true,false,[]);
7140       Last:=LastAtoms.GetPriorAtom;
7141       Parts[ppIndex].EndPos:=Last.EndPos;
7142       PartIsAtom[ppIndex]:=false;
7143     end;
7144   end;
7145 
7146   procedure ReadDispidSpecifier;
7147   begin
7148     if UpAtomIs('DISPID') then begin
7149       if Parts[ppDispidWord].StartPos>=1 then
7150         RaiseException(20170421201742,ctsDispidSpecifierRedefined);
7151       Parts[ppDispidWord]:=CurPos;
7152       ReadNextAtom;
7153       if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7154         CurPos.EndPos-CurPos.StartPos) then
7155         RaiseExceptionFmt(20170421201744,ctsDispidParameterExpectedButAtomFound,[GetAtom]);
7156       Parts[ppDispid].StartPos:=CurPos.StartPos;
7157       ReadConstant(true,false,[]);
7158       Parts[ppDispid].EndPos:=LastAtoms.GetPriorAtom.EndPos;
7159       PartIsAtom[ppDispid]:=false;
7160     end;
7161   end;
7162 
7163   procedure ReadReadSpecifier;
7164   begin
7165     if UpAtomIs('READ') then ReadSimpleSpec(ppReadWord,ppRead);
7166   end;
7167 
7168   procedure ReadWriteSpecifier;
7169   begin
7170     if UpAtomIs('WRITE') then ReadSimpleSpec(ppWriteWord,ppWrite);
7171   end;
7172 
7173   procedure ReadOptionalSpecifiers;
7174   begin
7175     while (CurPos.StartPos<PropNode.EndPos) do begin
7176       if (CurPos.Flag in [cafSemicolon,cafEnd]) then break;
7177       if UpAtomIs('STORED') then begin
7178         ReadSimpleSpec(ppStoredWord,ppStored);
7179       end else if UpAtomIs('DEFAULT') then begin
7180         if Parts[ppDefaultWord].StartPos>=1 then
7181           RaiseException(20170421201746,ctsDefaultSpecifierRedefined);
7182         Parts[ppDefaultWord]:=CurPos;
7183         ReadNextAtom;
7184         if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7185           CurPos.EndPos-CurPos.StartPos) then
7186           RaiseExceptionFmt(20170421201748,ctsDefaultParameterExpectedButAtomFound,[GetAtom]);
7187         Parts[ppDefault].StartPos:=CurPos.StartPos;
7188         ReadConstant(true,false,[]);
7189         Parts[ppDefault].EndPos:=LastAtoms.GetPriorAtom.EndPos;
7190         PartIsAtom[ppDefault]:=false;
7191       end else if UpAtomIs('NODEFAULT') then begin
7192         if Parts[ppNoDefaultWord].StartPos>=1 then
7193           RaiseException(20170421201750,ctsNodefaultSpecifierDefinedTwice);
7194         Parts[ppNoDefaultWord]:=CurPos;
7195         ReadNextAtom;
7196       end else if UpAtomIs('IMPLEMENTS') then begin
7197         ReadSimpleSpec(ppImplementsWord,ppImplements);
7198         while CurPos.Flag=cafComma do begin
7199           ReadNextAtom;
7200           AtomIsIdentifierE;
7201           if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7202             CurPos.EndPos-CurPos.StartPos) then
7203             RaiseExceptionFmt(20170421201752,ctsIndexParameterExpectedButAtomFound,[GetAtom]);
7204           ReadNextAtom;
7205         end;
7206       end else
7207         RaiseExceptionFmt(20170421201755,ctsStrExpectedButAtomFound,[';',GetAtom]);
7208     end;
7209   end;
7210 
7211   procedure ResolveIndexType;
7212   var
7213     ExprType: TExpressionType;
7214     Params: TFindDeclarationParams;
7215   begin
7216     Params:=TFindDeclarationParams.Create;
7217     try
7218       Params.Flags:=fdfDefaultForExpressions;
7219       Params.ContextNode:=PropNode;
7220       IndexType:=FindTermTypeAsString(Parts[ppIndex],Params,ExprType);
7221     finally
7222       Params.Free;
7223     end;
7224   end;
7225 
7226   procedure CompleteReadSpecifier;
7227   var
7228     IsGetterFunc: boolean;
7229     VarCode: String;
7230     AccessParamPrefix: String;
7231     AccessParam: String;
7232     AccessFunc: String;
7233   begin
7234     // check read specifier
7235     VariableName:='';
7236     if not PartIsAtom[ppRead] then exit;
7237     if (Parts[ppReadWord].StartPos<=0) and (Parts[ppWriteWord].StartPos>0) then
7238       exit;
7239     {$IFDEF CTDEBUG}
7240     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] read specifier needed');
7241     {$ENDIF}
7242     AccessParamPrefix:=BeautifyCodeOpts.PropertyReadIdentPrefix;
7243     if Parts[ppRead].StartPos>0 then
7244       AccessParam:=copy(Src,Parts[ppRead].StartPos,
7245                         Parts[ppRead].EndPos-Parts[ppRead].StartPos)
7246     else begin
7247       if (Parts[ppParamList].StartPos>0) or (Parts[ppIndexWord].StartPos>0)
7248       or (SysUtils.CompareText(AccessParamPrefix,
7249               LeftStr(AccessParam,length(AccessParamPrefix)))=0)
7250       or (CodeCompleteClassNode.Desc in AllClassInterfaces) then
7251       begin
7252         // create the default read identifier for a function
AccessParamnull7253         AccessParam:=AccessParamPrefix+PropName;
7254       end else begin
7255         // create the default read identifier for a variable
7256         AccessParam:=BeautifyCodeOpts.PrivateVariablePrefix+PropName;
7257       end;
7258     end;
7259 
7260     // complete read identifier in property definition
7261     if (Parts[ppRead].StartPos<0) and CompleteProperties then begin
7262       // insert read specifier
7263       if Parts[ppReadWord].StartPos>0 then begin
7264         // 'read' keyword exists -> insert read identifier behind
7265         InsertPos:=Parts[ppReadWord].EndPos;
7266         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,AccessParam);
7267       end else begin
7268         // 'read' keyword does not exist -> insert behind index and type
7269         if Parts[ppIndex].StartPos>0 then
7270           InsertPos:=Parts[ppIndex].EndPos
7271         else if Parts[ppIndexWord].StartPos>0 then
7272           InsertPos:=Parts[ppIndexWord].EndPos
7273         else
7274           InsertPos:=Parts[ppType].EndPos;
7275         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7276            BeautifyCodeOpts.BeautifyKeyWord('read')+' '+AccessParam);
7277       end;
7278     end;
7279 
7280     IsGetterFunc:=(Parts[ppParamList].StartPos>0)
7281       or ((Parts[ppIndexWord].StartPos>0)
7282           and not VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)))
7283       or (SysUtils.CompareText(AccessParamPrefix,
7284             LeftStr(AccessParam,length(AccessParamPrefix)))=0)
7285       or (CodeCompleteClassNode.Desc in AllClassInterfaces);
7286     if not IsGetterFunc then
7287       VariableName:=AccessParam;
7288 
7289     // check if read access method exists
7290     if (Parts[ppIndexWord].StartPos<1) then begin
7291       if (Parts[ppParamList].StartPos>0) then begin
7292         // param list, no index
7293         CleanAccessFunc:=UpperCaseStr(AccessParam)+'('+CleanParamList+');';
7294       end else begin
7295         // no param list, no index
7296         CleanAccessFunc:=UpperCaseStr(AccessParam)+';';
7297       end;
7298     end else begin
7299       // ToDo: find out type of index
7300       if (Parts[ppParamList].StartPos>0) then begin
7301         // param list + index
7302         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+CleanParamList+';'+IndexType+');');
7303       end else begin
7304         // index, no param list
7305         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+IndexType+');');
7306       end;
7307     end;
7308     if ProcExistsInCodeCompleteClass(CleanAccessFunc) then exit;
7309 
7310     // check if read access variable exists
7311     if (Parts[ppParamList].StartPos<1)
7312     and (CodeCompleteClassNode.Desc in AllClassObjects)
7313     and VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)) then exit;
7314 
7315     // complete read access specifier
7316     if IsGetterFunc then begin
7317       // the read identifier is a function
7318       {$IFDEF CTDEBUG}
7319       DebugLn('[TCodeCompletionCodeTool.CompleteProperty] CleanAccessFunc ',CleanAccessFunc,' does not exist');
7320       {$ENDIF}
7321       // add insert demand for function
7322       // build function code
7323       if (Parts[ppParamList].StartPos>0) then begin
7324         MoveCursorToCleanPos(Parts[ppParamList].StartPos);
7325         ReadNextAtom;
7326         InitExtraction;
7327         if not ReadParamList(true,true,[phpWithParameterNames,
7328                              phpWithoutBrackets,phpWithVarModifiers,
7329                              phpWithComments])
7330         then begin
7331           {$IFDEF CTDEBUG}
7332           DebugLn('[TCodeCompletionCodeTool.CompleteProperty] Error reading param list');
7333           {$ENDIF}
7334           RaiseException(20170421201756,ctsErrorInParamList);
7335         end;
7336         ParamList:=GetExtraction(false);
7337         if (Parts[ppIndexWord].StartPos<1) then begin
7338           // param list, no index
7339           AccessFunc:='function '+AccessParam
7340                       +'('+ParamList+'):'+PropType+';';
7341         end else begin
7342           // param list + index
7343           AccessFunc:='function '+AccessParam
7344                       +'('+ParamList+'; AIndex:'+IndexType+'):'+PropType+';';
7345         end;
7346       end else begin
7347         if (Parts[ppIndexWord].StartPos<1) then begin
7348           // no param list, no index
7349           AccessFunc:='function '+AccessParam+':'+PropType+';';
7350         end else begin
7351           // index, no param list
7352           AccessFunc:='function '+AccessParam
7353                       +'(AIndex:'+IndexType+'):'+PropType+';';
7354         end;
7355       end;
7356       if IsClassProp then
7357         AccessFunc:='class '+AccessFunc+' static;';
7358       // add new Insert Node
7359       if CompleteProperties then
7360         AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7361                           ncpPrivateProcs,PropNode);
7362     end else begin
7363       // the read identifier is a variable
7364       // variable does not exist yet -> add insert demand for variable
7365       VarCode:=VariableName+':'+PropType+';';
7366       if IsClassProp then VarCode:='class var '+VarCode;
7367       AddClassInsertion(UpperCaseStr(VariableName),
7368          VarCode,VariableName,ncpPrivateVars,PropNode);
7369     end;
7370   end;
7371 
7372   procedure CompleteWriteSpecifier;
7373   var
7374     ProcBody: String;
7375     AccessParamPrefix: String;
7376     AccessParam: String;
7377     AccessFunc: String;
7378     AccessVariableName, AccessVariableNameParam: String;
7379   begin
7380     // check write specifier
7381     if not PartIsAtom[ppWrite] then exit;
7382     if (Parts[ppWriteWord].StartPos<1) and (Parts[ppReadWord].StartPos>0) then
7383       exit;
7384     {$IFDEF CTDEBUG}
7385     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] write specifier needed');
7386     {$ENDIF}
7387     AccessParamPrefix:=BeautifyCodeOpts.PropertyWriteIdentPrefix;
7388     if Parts[ppWrite].StartPos>0 then
7389       AccessParam:=copy(Src,Parts[ppWrite].StartPos,
7390             Parts[ppWrite].EndPos-Parts[ppWrite].StartPos)
7391     else
7392       AccessParam:=AccessParamPrefix+PropName;
7393 
7394     // complete property definition for write specifier
7395     if (Parts[ppWrite].StartPos<0) and CompleteProperties then begin
7396       // insert write specifier
7397       if Parts[ppWriteWord].StartPos>0 then begin
7398         // 'write' keyword exists -> insert write identifier behind
7399         InsertPos:=Parts[ppWriteWord].EndPos;
7400         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7401            AccessParam);
7402       end else begin
7403         // 'write' keyword does not exist
7404         //  -> insert behind type, index and write specifier
7405         if Parts[ppRead].StartPos>0 then
7406           InsertPos:=Parts[ppRead].EndPos
7407         else if Parts[ppReadWord].StartPos>0 then
7408           InsertPos:=Parts[ppReadWord].EndPos
7409         else if Parts[ppIndex].StartPos>0 then
7410           InsertPos:=Parts[ppIndex].EndPos
7411         else if Parts[ppIndexWord].StartPos>0 then
7412           InsertPos:=Parts[ppIndexWord].EndPos
7413         else
7414           InsertPos:=Parts[ppType].EndPos;
7415         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7416            BeautifyCodeOpts.BeautifyKeyWord('write')+' '+AccessParam);
7417       end;
7418     end;
7419 
7420     // check if write method exists
7421     if (Parts[ppIndexWord].StartPos<1) then begin
7422       if (Parts[ppParamList].StartPos>0) then begin
7423         // param list, no index
7424         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+CleanParamList+';'
7425                            +PropType+');');
7426       end else begin
7427         // no param list, no index
7428         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+PropType+');');
7429       end;
7430     end else begin
7431       // ToDo: find out index type
7432       if (Parts[ppParamList].StartPos>0) then begin
7433         // param list + index
7434         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+CleanParamList+';'+IndexType+';'+PropType+');');
7435       end else begin
7436         // index, no param list
7437         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+IndexType+';'+PropType+');');
7438       end;
7439     end;
7440     if ProcExistsInCodeCompleteClass(CleanAccessFunc) then exit;
7441 
7442     // check if write variable exists
7443     if (Parts[ppParamList].StartPos<1)
7444     and (CodeCompleteClassNode.Desc in AllClassObjects)
7445     and VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)) then exit;
7446 
7447     // complete class
7448     if (Parts[ppParamList].StartPos>0)
7449     or ((Parts[ppIndexWord].StartPos>0)
7450         and not VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)))
7451     or (SysUtils.CompareText(AccessParamPrefix,
7452             LeftStr(AccessParam,length(AccessParamPrefix)))=0)
7453     or (CodeCompleteClassNode.Desc in AllClassInterfaces) then
7454     begin
7455       // add insert demand for function
7456       // build function code
7457       ProcBody:='';
7458       AccessVariableName := SetPropertyVariablename;
7459       if SetPropertyVariableIsPrefix then
7460         AccessVariableName := AccessVariableName+PropName;
7461       if SetPropertyVariableUseConst then
7462         AccessVariableNameParam := 'const '+AccessVariableName
7463       else
7464         AccessVariableNameParam := AccessVariableName;
7465       if (Parts[ppParamList].StartPos>0) then begin
7466         MoveCursorToCleanPos(Parts[ppParamList].StartPos);
7467         ReadNextAtom;
7468         InitExtraction;
7469         if not ReadParamList(true,true,[phpWithParameterNames,
7470                              phpWithoutBrackets,phpWithVarModifiers,
7471                              phpWithComments])
7472         then
7473           RaiseException(20170421201758,ctsErrorInParamList);
7474         ParamList:=GetExtraction(false);
7475         if (Parts[ppIndexWord].StartPos<1) then begin
7476           // param list, no index
7477           AccessFunc:='procedure '+AccessParam
7478                       +'('+ParamList+';'+AccessVariableNameParam+':'
7479                       +PropType+');';
7480         end else begin
7481           // param list+ index
7482           AccessFunc:='procedure '+AccessParam
7483                       +'('+ParamList+';AIndex:'+IndexType+';'
7484                       +AccessVariableNameParam+':'+PropType+');';
7485         end;
7486       end else begin
7487         if (Parts[ppIndexWord].StartPos<1) then begin
7488           // no param list, no index
7489           AccessFunc:=
7490             'procedure '+AccessParam
7491             +'('+AccessVariableNameParam+':'+PropType+');';
7492           if VariableName<>'' then begin
7493             { read spec is a variable -> add simple assign code to body
7494               For example:
7495 
7496               procedure SetMyInt(AValue: integer);
7497               begin
7498                 if FMyInt=AValue then exit;
7499                 FMyInt:=AValue;
7500               end;
7501 
7502             }
7503             {$IFDEF EnableCodeCompleteTemplates}
7504             if assigned(CTTemplateExpander)
7505             and CTTemplateExpander.TemplateExists('SetterMethod') then
7506             begin
7507               debugln(['CompleteWriteSpecifier ', 'USING template for SetterMethod']);
7508               ProcBody := CTTemplateExpander.Expand( 'SetterMethod',
7509                  BeautifyCodeOpts.LineEnd,
7510                  GetIndentStr(BeautifyCodeOpts.Indent),
7511                  ['ClassName',                                   'AccessParam','PropVarName',           'PropType','VarName'],
7512                  [ExtractClassName(PropNode.Parent.Parent,false), AccessParam,  SetPropertyVariablename, PropType,  VariableName] );
7513             end
7514             else
7515             {$ENDIF}
7516             begin
7517               ProcBody:=
7518                 'procedure '
7519                 +ExtractClassName(PropNode.Parent.Parent,false,true,Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE])+'.'+AccessParam
7520                 +'('+AccessVariableNameParam+':'+PropType+');'
7521                 +BeautifyCodeOpts.LineEnd
7522                 +'begin'+BeautifyCodeOpts.LineEnd
7523                 +BeautifyCodeOpts.GetIndentStr(BeautifyCodeOpts.Indent)
7524                   +'if '+VariableName+'='+AccessVariableName+' then Exit;'
7525                   +BeautifyCodeOpts.LineEnd
7526                 +BeautifyCodeOpts.GetIndentStr(BeautifyCodeOpts.Indent)
7527                   +VariableName+':='+AccessVariableName+';'
7528                   +BeautifyCodeOpts.LineEnd
7529                 +'end;';
7530             end;
7531             if IsClassProp then
7532               ProcBody:='class '+ProcBody;
7533           end;
7534         end else begin
7535           // index, no param list
7536           AccessFunc:='procedure '+AccessParam
7537                   +'(AIndex:'+IndexType+';'+AccessVariableNameParam+':'+PropType+');';
7538         end;
7539       end;
7540       // add new Insert Node
7541       if IsClassProp then
7542         AccessFunc:='class '+AccessFunc+' static;';
7543       if CompleteProperties then
7544         AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7545                           ncpPrivateProcs,PropNode,ProcBody);
7546     end else begin
7547       // the write identifier is a variable
7548       // -> add insert demand for variable
7549       if CompleteProperties then
7550         AddClassInsertion(UpperCaseStr(AccessParam),
7551            AccessParam+':'+PropType+';',AccessParam,ncpPrivateVars,PropNode);
7552     end;
7553   end;
7554 
7555   procedure CompleteStoredSpecifier;
7556   var
7557     AccessParam: String;
7558     AccessFunc: String;
7559   begin
7560     // check stored specifier
7561     if not PartIsAtom[ppStored] then exit;
7562     if (Parts[ppStoredWord].StartPos<1) then exit;
7563     {$IFDEF CTDEBUG}
7564     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] stored specifier needed');
7565     {$ENDIF}
7566     if Parts[ppStored].StartPos>0 then begin
7567       if (CompareIdentifiers(@Src[Parts[ppStored].StartPos],'False')=0)
7568       or (CompareIdentifiers(@Src[Parts[ppStored].StartPos],'True')=0) then
7569         exit;
7570       AccessParam:=copy(Src,Parts[ppStored].StartPos,
7571             Parts[ppStored].EndPos-Parts[ppStored].StartPos);
7572     end else
7573       AccessParam:=PropName
7574         +BeautifyCodeOpts.PropertyStoredIdentPostfix;
7575     if (Parts[ppIndexWord].StartPos<1) then begin
7576       // no index -> check if method or field exists
7577       CleanAccessFunc:=UpperCaseStr(AccessParam);
7578       if (not ProcExistsInCodeCompleteClass(CleanAccessFunc+';'))
7579       and (not VarExistsInCodeCompleteClass(CleanAccessFunc))
7580       then begin
7581         // add insert demand for function
7582         // build function code
7583         AccessFunc := 'function ' + AccessParam + ':Boolean;';
7584         CleanAccessFunc := CleanAccessFunc+';';
7585         if IsClassProp then
7586           AccessFunc:='class '+AccessFunc+' static;';;
7587         // add new Insert Node
7588         if CompleteProperties then
7589           AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7590                             ncpPrivateProcs,PropNode);
7591       end;
7592     end else begin
7593       // has index specifier -> check if method exists
7594       CleanAccessFunc:=UpperCaseStr(AccessParam);
7595       if (not ProcExistsInCodeCompleteClass(CleanAccessFunc+'('+UpperCaseStr(IndexType)+');'))
7596       and (not VarExistsInCodeCompleteClass(CleanAccessFunc))
7597       then begin
7598         // add insert demand for function
7599         // build function code
7600         AccessFunc := 'function ' + AccessParam + '(AIndex:'+IndexType+'):Boolean;';
7601         CleanAccessFunc := UpperCaseStr(CleanAccessFunc + '('+IndexType+');');
7602         if IsClassProp then
7603           AccessFunc:='class '+AccessFunc+' static;';
7604         // add new Insert Node
7605         if CompleteProperties then
7606           AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7607                             ncpPrivateProcs,PropNode);
7608       end;
7609     end;
7610     if Parts[ppStored].StartPos<0 then begin
7611       // insert stored specifier
7612       InsertPos:=Parts[ppStoredWord].EndPos;
7613       if CompleteProperties then
7614         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7615                                    AccessParam);
7616     end;
7617   end;
7618 
7619   procedure CompleteSemicolon;
7620   begin
7621     if (PropNode.EndPos<=SrcLen) and (Src[PropNode.EndPos-1]<>';') then begin
7622       InsertPos:=PropNode.EndPos;
7623       if CompleteProperties then
7624         FSourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,';');
7625     end;
7626   end;
7627 
7628 begin
7629   Result:=false;
7630   InitCompleteProperty;
7631   ReadPropertyKeywordAndName;
7632   ReadPropertyParamList;
7633 
7634   {$IFDEF CTDEBUG}
7635   DebugLn('[TCodeCompletionCodeTool.CompleteProperty] Checking Property ',GetAtom);
7636   {$ENDIF}
7637   if not AtomIsChar(':') then begin
7638     {$IFDEF CTDEBUG}
7639     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] no type : found -> ignore property');
7640     {$ENDIF}
7641     // no type -> ignore this property
7642     Result:=true;
7643     exit;
7644   end;
7645 
7646   PropType:=ReadPropertyType;
7647   // parse specifiers
7648   if CodeCompleteClassNode.Desc <> ctnDispinterface then begin
7649     ReadIndexSpecifier;
7650     ReadReadSpecifier;
7651     ReadWriteSpecifier;
7652     ReadOptionalSpecifiers;
7653   end else begin
7654     if UpAtomIs('READONLY') or UpAtomIs('WRITEONLY') then
7655       ReadNextAtom;
7656     ReadDispidSpecifier;
7657   end;
7658 
7659   // complete property
7660   BeautifyCodeOpts:=FSourceChangeCache.BeautifyCodeOptions;
7661   if CodeCompleteClassNode.Desc <> ctnDispinterface then begin
7662     if Parts[ppIndex].StartPos>0 then
7663       ResolveIndexType;
7664     CompleteReadSpecifier;
7665     CompleteWriteSpecifier;
7666     CompleteStoredSpecifier;
7667   end;
7668   CompleteSemicolon;
7669 
7670   Result:=true;
7671 end;
7672 
TCodeCompletionCodeTool.GetFirstClassIdentifiernull7673 function TCodeCompletionCodeTool.GetFirstClassIdentifier(
7674   ClassNode: TCodeTreeNode): TCodeTreeNode;
7675 const
7676   Identifiers = AllIdentifierDefinitions+[ctnProperty,ctnProcedure,ctnClassGUID];
7677 begin
7678   if ClassNode=nil then exit(nil);
7679   Result:=ClassNode.FirstChild;
7680   while Result<>nil do begin
7681     if (Result.Desc in Identifiers) then
7682       exit;
7683     Result:=FindNextIdentNodeInClass(Result);
7684   end;
7685 end;
7686 
7687 procedure TCodeCompletionCodeTool.InsertNewClassParts(PartType: TNewClassPart);
7688 var ANodeExt: TCodeTreeNodeExtension;
7689   ClassSectionNode, ANode, InsertNode: TCodeTreeNode;
7690   Indent, InsertPos: integer;
7691   CurCode: string;
7692   IsVariable, InsertBehind: boolean;
7693   Visibility: TPascalClassSection;
7694   Beauty: TBeautifyCodeOptions;
7695 begin
7696   ANodeExt:=FirstInsert;
7697   Visibility:=NewClassPartVisibility[PartType];
7698   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
7699   // insert all nodes of specific type
7700   while ANodeExt<>nil do begin
7701     IsVariable:=NodeExtIsVariable(ANodeExt);
7702     if (cardinal(ord(PartType))=ANodeExt.Flags) then begin
7703       // search a destination section
7704       ClassSectionNode:=nil;
7705       if Visibility=pcsPublished then begin
7706         // insert into first published section
7707         ClassSectionNode:=CodeCompleteClassNode.FirstChild;
7708         while not (ClassSectionNode.Desc in AllClassSections) do
7709           ClassSectionNode:=ClassSectionNode.NextBrother;
7710         // the first class section is always a published section, even if there
7711         // is no 'published' keyword. If the class starts with the 'published'
7712         // keyword, then it will be more beautiful to insert vars and procs to
7713         // this second published section
7714         if (ClassSectionNode.FirstChild=nil)
7715         and (ClassSectionNode.NextBrother<>nil)
7716         and (ClassSectionNode.NextBrother.Desc=ctnClassPublished)
7717         then
7718           ClassSectionNode:=ClassSectionNode.NextBrother;
7719       end else if ANodeExt.Node<>nil then begin
7720         // search a section of the same Visibility in front of the node
7721         if CodeCompleteClassNode.Desc in AllClassObjects then
7722         begin
7723           ClassSectionNode:=ANodeExt.Node.Parent.PriorBrother;
7724           while (ClassSectionNode<>nil)
7725           and (ClassSectionNode.Desc<>ClassSectionNodeType[Visibility]) do
7726             ClassSectionNode:=ClassSectionNode.PriorBrother;
7727         end else begin
7728           ClassSectionNode:=CodeCompleteClassNode;
7729         end;
7730       end else begin
7731         // search a section of the same Visibility
7732         if CodeCompleteClassNode.Desc in AllClassObjects then
7733         begin
7734           ClassSectionNode:=CodeCompleteClassNode.FirstChild;
7735           while (ClassSectionNode<>nil)
7736           and (ClassSectionNode.Desc<>ClassSectionNodeType[Visibility]) do
7737             ClassSectionNode:=ClassSectionNode.NextBrother;
7738         end else begin
7739           ClassSectionNode:=CodeCompleteClassNode;
7740         end;
7741       end;
7742       if ClassSectionNode=nil then begin
7743         // there is no existing class section node
7744         // -> insert in the new one
7745         Indent:=NewClassSectionIndent[Visibility]+Beauty.Indent;
7746         InsertPos:=NewClassSectionInsertPos[Visibility];
7747         if InsertPos<1 then
7748           raise Exception.Create('TCodeCompletionCodeTool.InsertNewClassParts inconsistency: missing section: please create a bug report');
7749       end else begin
7750         // there is an existing class section to insert into
7751 
7752         // find a nice insert position
7753         InsertNode:=nil; // the new part will be inserted after this node
7754                          //   nil means insert as first
7755         InsertBehind:=true;
7756         ANode:=ClassSectionNode.FirstChild;
7757 
7758         // skip the class GUID
7759         if (ANode<>nil) and (ANode.Desc=ctnClassGUID) then begin
7760           InsertNode:=ANode;
7761           ANode:=ANode.NextBrother;
7762         end;
7763 
7764         // insert methods behind variables
7765         if not IsVariable then begin
7766           while (ANode<>nil) and (ANode.Desc=ctnVarDefinition) do begin
7767             InsertNode:=ANode;
7768             ANode:=ANode.NextBrother;
7769           end;
7770         end;
7771 
7772         // find a nice position between similar siblings
7773         case Beauty.ClassPartInsertPolicy of
7774 
7775         cpipAlphabetically:
7776           begin
7777             while ANode<>nil do begin
7778               if IsVariable then begin
7779                 // the insertion is a new variable
7780                 if (ANode.Desc<>ctnVarDefinition)
7781                 or (CompareNodeIdentChars(ANode,ANodeExt.Txt)<0) then
7782                   break;
7783               end else begin
7784                 // the insertion is a new method
7785                 case ANode.Desc of
7786 
7787                 ctnProcedure:
7788                   begin
7789                     CurCode:=ExtractProcName(ANode,[]);
7790                     if SysUtils.CompareText(CurCode,ANodeExt.ExtTxt2)>0 then
7791                       break;
7792                   end;
7793 
7794                 ctnProperty:
7795                   begin
7796                     if FSourceChangeCache.BeautifyCodeOptions
7797                         .MixMethodsAndProperties then
7798                     begin
7799                       CurCode:=ExtractPropName(ANode,false);
7800                       if SysUtils.CompareText(CurCode,ANodeExt.ExtTxt2)>0 then
7801                         break;
7802                     end else
7803                       break;
7804                   end;
7805 
7806                 end;
7807               end;
7808               InsertNode:=ANode;
7809               ANode:=ANode.NextBrother;
7810             end;
7811           end;
7812 
7813         else
7814           // cpipLast
7815           begin
7816             while ANode<>nil do begin
7817               if IsVariable then begin
7818                 // the insertion is a variable
7819                 if (ANode.Desc<>ctnVarDefinition) then
7820                   break;
7821               end else begin
7822                 // the insertion is a method
7823                 if (not Beauty.MixMethodsAndProperties)
7824                 and (ANode.Desc=ctnProperty) then
7825                   break;
7826               end;
7827               InsertNode:=ANode;
7828               ANode:=ANode.NextBrother;
7829             end;
7830           end
7831         end;
7832 
7833         if InsertNode<>nil then begin
7834           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert behind existing']);
7835           // for variable lists: a,b,c: integer
7836           // use last node
7837           if InsertBehind then begin
7838             while (InsertNode.Desc=ctnVarDefinition)
7839             and (InsertNode.FirstChild=nil)
7840             and (InsertNode.NextBrother<>nil)
7841             and (InsertNode.NextBrother.Desc=ctnVarDefinition) do
7842               InsertNode:=InsertNode.NextBrother;
7843           end;
7844 
7845           if (not IsVariable) and (InsertNode.Desc=ctnVarDefinition)
7846           and (InsertNode.NextBrother<>nil) then begin
7847             // insertion is a new method and it should be inserted behind
7848             // variables. Because methods and variables should be separated
7849             // there is a next node, insert the new method in front of the next
7850             // node, instead of inserting it right behind the variable.
7851             // This makes sure to use existing separation comments/empty lines.
7852             InsertNode:=InsertNode.NextBrother;
7853             InsertBehind:=false;
7854           end;
7855 
7856           Indent:=Beauty.GetLineIndent(Src,InsertNode.StartPos);
7857           if InsertBehind then begin
7858             // insert behind InsertNode
7859             InsertPos:=FindLineEndOrCodeAfterPosition(InsertNode.EndPos);
7860           end else begin
7861             // insert in front of InsertNode
7862             InsertPos:=InsertNode.StartPos;
7863           end;
7864         end else begin
7865           // insert as first variable/proc
7866           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first var: ',ClassSectionNode.DescAsString,' ',dbgstr(copy(Src,ClassSectionNode.StartPos,ClassSectionNode.EndPos-ClassSectionNode.StartPos))]);
7867           Indent:=Beauty.GetLineIndent(Src,ClassSectionNode.StartPos)+Beauty.Indent;
7868           InsertPos:=ClassSectionNode.StartPos;
7869           if (ClassSectionNode.Desc=ctnClassPublished)
7870           and (CompareIdentifiers(@Src[ClassSectionNode.StartPos],'published')<>0)
7871           then begin
7872             // the first published section has no keyword
7873             if ClassSectionNode.NextBrother<>nil then
7874               Indent:=Beauty.GetLineIndent(Src,ClassSectionNode.NextBrother.StartPos)
7875                       +Beauty.Indent
7876             else
7877               Indent:=Beauty.GetLineIndent(Src,ClassSectionNode.Parent.StartPos)
7878                       +Beauty.Indent;
7879           end else if (ClassSectionNode.Desc in AllClassBaseSections)
7880           then begin
7881             // skip keyword
7882             MoveCursorToCleanPos(InsertPos);
7883             ReadNextAtom;
7884             if UpAtomIs('STRICT') then
7885               ReadNextAtom;
7886             //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first of ',ClassSectionNode.DescAsString,' Atom=',GetAtom]);
7887             ANode:=ClassSectionNode.Next;
7888             if (ANode<>nil) and (CurPos.EndPos<=ANode.StartPos) then
7889               InsertPos:=CurPos.EndPos;
7890           end else if ClassSectionNode.Desc in AllClassInterfaces then begin
7891             // skip class interface header
7892             MoveCursorToCleanPos(InsertPos);
7893             ReadNextAtom; // skip 'interface'
7894             InsertPos:=CurPos.EndPos;
7895             if ReadNextAtomIsChar('(') then begin
7896               ReadTilBracketClose(true);
7897               InsertPos:=CurPos.EndPos;
7898             end;
7899           end;
7900           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first, somewhere after InsertPos=',CleanPosToStr(InsertPos)]);
7901           InsertPos:=FindLineEndOrCodeAfterPosition(InsertPos);
7902           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first, InsertPos=',CleanPosToStr(InsertPos)]);
7903         end;
7904       end;
7905       CurCode:=ANodeExt.ExtTxt1;
7906       CurCode:=Beauty.BeautifyStatement(CurCode,Indent,[bcfChangeSymbolToBracketForGenericTypeBrackets]);
7907       {$IFDEF CTDEBUG}
7908       DebugLn('TCodeCompletionCodeTool.InsertNewClassParts:');
7909       DebugLn(CurCode);
7910       {$ENDIF}
7911       FSourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
7912          CurCode);
7913       if (not IsVariable) and (Beauty.MethodInsertPolicy=mipClassOrder) then
7914       begin
7915         // this was a new method definition and the body should be added in
7916         // Class Order
7917         // -> save information about the inserted position
7918         ANodeExt.Position:=InsertPos;
7919       end;
7920     end;
7921     ANodeExt:=ANodeExt.Next;
7922   end;
7923 end;
7924 
TCodeCompletionCodeTool.InsertAllNewClassPartsnull7925 function TCodeCompletionCodeTool.InsertAllNewClassParts: boolean;
7926 var
7927   NewSectionKeyWordNeeded: boolean;
7928   NewSection: TPascalClassSection;
7929   Beauty: TBeautifyCodeOptions;
7930 
GetTopMostPositionNodenull7931   function GetTopMostPositionNode(Visibility: TPascalClassSection
7932     ): TCodeTreeNode;
7933   var
7934     ANodeExt: TCodeTreeNodeExtension;
7935   begin
7936     Result:=nil;
7937     ANodeExt:=FirstInsert;
7938     while ANodeExt<>nil do begin
7939       if (ANodeExt.Node<>nil)
7940       and ((Result=nil) or (Result.StartPos>ANodeExt.Node.StartPos))
7941       and (NodeExtHasVisibilty(ANodeExt,Visibility))
7942       then
7943         Result:=ANodeExt.Node;
7944       ANodeExt:=ANodeExt.Next;
7945     end;
7946   end;
7947 
GetFirstNodeExtWithVisibilitynull7948   function GetFirstNodeExtWithVisibility(Visibility: TPascalClassSection
7949     ): TCodeTreeNodeExtension;
7950   begin
7951     Result:=FirstInsert;
7952     while Result<>nil do begin
7953       if NodeExtHasVisibilty(Result,Visibility) then
7954         break;
7955       Result:=Result.Next;
7956     end;
7957   end;
7958 
GetFirstVisibilitySectionNodenull7959   function GetFirstVisibilitySectionNode: TCodeTreeNode;
7960   begin
7961     if CodeCompleteClassNode.Desc in AllClassInterfaces then
7962       Result:=CodeCompleteClassNode
7963     else begin
7964       Result:=CodeCompleteClassNode.FirstChild;
7965       while not (Result.Desc in AllClassBaseSections) do
7966         Result:=Result.NextBrother;
7967     end;
7968   end;
7969 
7970   procedure AddClassSection(Visibility: TPascalClassSection);
7971   var
7972     TopMostPositionNode: TCodeTreeNode;
7973     SectionNode: TCodeTreeNode;
7974     SectionKeyWord: String;
7975     ANode: TCodeTreeNode;
7976     FirstVisibilitySection: TCodeTreeNode;
7977     NewCode: String;
7978     Beauty: TBeautifyCodeOptions;
7979   begin
7980     NewClassSectionInsertPos[Visibility]:=-1;
7981     NewClassSectionIndent[Visibility]:=0;
7982     if CodeCompleteClassNode.Desc in AllClassInterfaces then begin
7983       // a class interface has no sections
7984       exit;
7985     end;
7986 
7987     // check if section is needed
7988     if GetFirstNodeExtWithVisibility(Visibility)=nil then exit;
7989     // search topmost position node for this Visibility
7990     TopMostPositionNode:=GetTopMostPositionNode(Visibility);
7991     SectionNode:=nil;
7992     // search a Visibility section in front of topmost position node
7993     if TopMostPositionNode<>nil then begin
7994       SectionNode:=TopMostPositionNode;
7995       while (SectionNode<>nil) and (SectionNode.Parent<>CodeCompleteClassNode)
7996       do
7997         SectionNode:=SectionNode.Parent;
7998       if SectionNode<>nil then
7999         SectionNode:=SectionNode.PriorBrother;
8000     end else
8001       SectionNode:=CodeCompleteClassNode.LastChild;
8002     while (SectionNode<>nil)
8003     and (SectionNode.Desc<>ClassSectionNodeType[Visibility]) do
8004       SectionNode:=SectionNode.PriorBrother;
8005     if (SectionNode<>nil) then begin
8006       //DebugLn(['AddClassSection section exists for ',NodeDescriptionAsString(ClassSectionNodeType[Visibility])]);
8007       exit;
8008     end;
8009     { There is no section of this Visibility in front (or at all)
8010       -> Insert a new section in front of topmost node.
8011       Normally the best place for a new section is at the end of
8012       the first published section. But if a variable is already
8013       needed in the first published section, then the new section
8014       must be inserted in front of all }
8015     Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8016     FirstVisibilitySection:=GetFirstVisibilitySectionNode;
8017     if (TopMostPositionNode<>nil)
8018     and (FirstVisibilitySection<>nil)
8019     and ((TopMostPositionNode.HasAsParent(FirstVisibilitySection)
8020           or (TopMostPositionNode=FirstVisibilitySection)))
8021     then begin
8022       // topmost node is in the first section
8023       // -> insert the new section as the first section
8024       ANode:=FirstVisibilitySection;
8025       NewClassSectionIndent[Visibility]:=Beauty.GetLineIndent(Src,ANode.StartPos);
8026       if (ANode.FirstChild<>nil) and (ANode.FirstChild.Desc<>ctnClassGUID)
8027       then
8028         NewClassSectionInsertPos[Visibility]:=ANode.StartPos
8029       else
8030         NewClassSectionInsertPos[Visibility]:=ANode.FirstChild.EndPos;
8031       if (not NewSectionKeyWordNeeded)
8032       and (CompareNodeIdentChars(ANode, UpperCase(PascalClassSectionKeywords[NewSection]))<>0) then begin
8033         NewSectionKeyWordNeeded:=true;
8034         NewClassSectionInsertPos[NewSection]:=
8035           NewClassSectionInsertPos[Visibility];
8036         NewClassSectionIndent[NewSection]:=
8037           NewClassSectionIndent[Visibility];
8038       end;
8039     end else begin
8040       ANode:=nil;
8041       case Visibility of
8042       pcsProtected:
8043         // insert after last private section
8044         ANode:=FindLastClassSection(CodeCompleteClassNode,ctnClassPrivate);
8045       pcsPublic:
8046         begin
8047           // insert after last private, protected section
8048           ANode:=FindClassSection(CodeCompleteClassNode,ctnClassProtected);
8049           if ANode=nil then
8050             ANode:=FindClassSection(CodeCompleteClassNode,ctnClassPrivate);
8051         end;
8052       end;
8053       if ANode=nil then begin
8054         // default: insert new section behind first published section
8055         ANode:=FirstVisibilitySection;
8056       end;
8057       NewClassSectionIndent[Visibility]:=Beauty.GetLineIndent(Src,ANode.StartPos);
8058       NewClassSectionInsertPos[Visibility]:=ANode.EndPos;
8059     end;
8060     SectionKeyWord:=PascalClassSectionKeywords[Visibility];
8061     NewCode:=Beauty.BeautifyKeyWord(SectionKeyWord);
8062     FSourceChangeCache.Replace(gtNewLine,gtNewLine,
8063       NewClassSectionInsertPos[Visibility],
8064       NewClassSectionInsertPos[Visibility],
8065       Beauty.GetIndentStr(NewClassSectionIndent[Visibility])+NewCode);
8066   end;
8067 
8068 begin
8069   Result:=InsertClassHeaderComment;
8070   if not Result then exit;
8071 
8072   Result:=InsertMissingClassSemicolons;
8073   if not Result then exit;
8074 
8075   if FirstInsert=nil then begin
8076     Result:=true;
8077     exit;
8078   end;
8079   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8080 
8081   NewSectionKeyWordNeeded:=false;// 'published'/'public' keyword after first private section needed
8082   if CodeCompleteClassNode.Desc = ctnClass then
8083     NewSection := pcsPublished
8084   else
8085     NewSection := pcsPublic;
8086 
8087   AddClassSection(pcsPrivate);
8088   InsertNewClassParts(ncpPrivateVars);
8089   InsertNewClassParts(ncpPrivateProcs);
8090 
8091   AddClassSection(pcsProtected);
8092   InsertNewClassParts(ncpProtectedVars);
8093   InsertNewClassParts(ncpProtectedProcs);
8094 
8095   if NewSectionKeyWordNeeded and (NewSection = pcsPublic) then begin
8096     FSourceChangeCache.Replace(gtNewLine,gtNewLine,
8097       NewClassSectionInsertPos[NewSection],
8098       NewClassSectionInsertPos[NewSection],
8099       Beauty.GetIndentStr(NewClassSectionIndent[NewSection])+
8100         Beauty.BeautifyKeyWord(PascalClassSectionKeywords[NewSection]));
8101   end
8102   else
8103     AddClassSection(pcsPublic);
8104   InsertNewClassParts(ncpPublicVars);
8105   InsertNewClassParts(ncpPublicProcs);
8106 
8107   if NewSectionKeyWordNeeded and (NewSection = pcsPublished) then begin
8108     FSourceChangeCache.Replace(gtNewLine,gtNewLine,
8109       NewClassSectionInsertPos[NewSection],
8110       NewClassSectionInsertPos[NewSection],
8111       Beauty.GetIndentStr(NewClassSectionIndent[NewSection])+
8112         Beauty.BeautifyKeyWord(PascalClassSectionKeywords[NewSection]));
8113   end;
8114   InsertNewClassParts(ncpPublishedVars);
8115   InsertNewClassParts(ncpPublishedProcs);
8116 
8117   Result:=true;
8118 end;
8119 
InsertClassHeaderCommentnull8120 function TCodeCompletionCodeTool.InsertClassHeaderComment: boolean;
8121 var
8122   ClassNode: TCodeTreeNode;
8123   ClassIdentifierNode: TCodeTreeNode;
8124   Code: String;
8125   InsertPos: LongInt;
8126   Indent: LongInt;
8127   StartPos, CommentStart, CommentEnd: TCodeXYPosition;
8128   Beauty: TBeautifyCodeOptions;
8129 begin
8130   Result:=true;
8131   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8132   if not Beauty.ClassHeaderComments then exit;
8133   // check if there is already a comment in front of the class
8134 
8135   // find the start of the class (the position in front of the class name)
8136   ClassNode:=CodeCompleteClassNode;
8137   if ClassNode=nil then exit;
8138   ClassIdentifierNode:=
8139                    ClassNode.GetNodeOfTypes([ctnTypeDefinition,ctnGenericType]);
8140   if ClassIdentifierNode=nil then begin
8141     DebugLn('TCodeCompletionCodeTool.InsertClassHeaderComment WARNING: class without name', ClassNode.DescAsString);
8142     exit;
8143   end;
8144   if not CleanPosToCaret(ClassIdentifierNode.StartPos,StartPos) then exit;
8145   Code:=ExtractDefinitionName(ClassIdentifierNode);
8146 
8147   // check if there is already a comment in front
8148   if FindCommentInFront(StartPos,Code,false,true,false,false,true,true,
8149                         CommentStart,CommentEnd)
8150   then
8151     // comment already exists
8152     exit;
8153   if CommentStart.Code=nil then ;
8154   if CommentEnd.Code=nil then ;
8155 
8156   // insert comment in front
8157   InsertPos:=ClassIdentifierNode.StartPos;
8158   Indent:=Beauty.GetLineIndent(Src,InsertPos);
8159   Code:=Beauty.GetIndentStr(Indent)+'{ '+Code+' }';
8160   FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
8161                              InsertPos,InsertPos,Code);
8162 end;
8163 
InsertMissingClassSemicolonsnull8164 function TCodeCompletionCodeTool.InsertMissingClassSemicolons: boolean;
8165 var
8166   ANode: TCodeTreeNode;
8167   ProcCode: String;
8168 begin
8169   Result:=false;
8170   ANode:=FCompletingFirstEntryNode;
8171   while (ANode<>nil) do begin
8172     if ANode.Desc=ctnProcedure then begin
8173       if ANode.FirstChild=nil then begin
8174         debugln(['TCodeCompletionCodeTool.InsertMissingClassSemicolons warning: broken proc node: ',CleanPosToStr(ANode.StartPos)]);
8175         exit;
8176       end;
8177       ProcCode:=ExtractProcHead(ANode,[phpWithStart,
8178                   phpWithoutClassKeyword,
8179                   phpWithVarModifiers,phpWithParameterNames,phpWithResultType,
8180                   phpWithProcModifiers,phpDoNotAddSemicolon]);
8181       if (ProcCode<>'') and (ProcCode[length(ProcCode)]<>';') then begin
8182         // add missing semicolon at end of procedure head
8183         UndoReadNextAtom;
8184         {$IFDEF VerboseCompletionAdds}
8185         debugln(['TCodeCompletionCodeTool.InsertMissingClassSemicolons add missing semicolon at end of procedure head ProcCode="',dbgstr(ProcCode),'"']);
8186         {$ENDIF}
8187         if not FSourceChangeCache.Replace(gtNone,gtNone,
8188           CurPos.EndPos,CurPos.EndPos,';') then
8189             RaiseException(20170421201801,'InsertMissingClassSemicolons: unable to insert semicolon');
8190       end;
8191       MoveCursorToFirstProcSpecifier(ANode);
8192       if (CurPos.Flag<>cafSemicolon) and (CurPos.EndPos<ANode.FirstChild.EndPos)
8193       and (LastAtoms.HasPrior)
8194       then begin
8195         // add missing semicolon in front of proc modifiers
8196         UndoReadNextAtom;
8197         {$IFDEF VerboseCompletionAdds}
8198         debugln(['TCodeCompletionCodeTool.InsertMissingClassSemicolons add missing semicolon in front of proc modifiers ProcCode="',dbgstr(ProcCode),'"']);
8199         {$ENDIF}
8200         if not FSourceChangeCache.Replace(gtNone,gtNone,
8201           CurPos.EndPos,CurPos.EndPos,';') then
8202             RaiseException(20170421201804,'InsertMissingClassSemicolons: unable to insert semicolon');
8203       end;
8204     end;
8205     // next node
8206     if ANode.NextBrother<>nil then begin
8207       ANode:=ANode.NextBrother;
8208     end else begin
8209       ANode:=ANode.Parent.NextBrother;
8210       while (ANode<>nil) and (ANode.Desc in (AllCodeSections+AllClassSections))
8211       and (ANode.FirstChild=nil) do
8212         ANode:=ANode.NextBrother;
8213       if ANode<>nil then ANode:=ANode.FirstChild;
8214     end;
8215   end;
8216   Result:=true;
8217 end;
8218 
TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSectionnull8219 function TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection: boolean;
8220 var
8221   UsesNode: TCodeTreeNode;
8222   AVLNode: TAVLTreeNode;
8223   CurSourceName: String;
8224   SectionNode: TCodeTreeNode;
8225   NewUsesTerm: String;
8226   NewUnitName: String;
8227   InsertPos: LongInt;
8228 begin
8229   Result:=true;
8230   if (fNewMainUsesSectionUnits=nil) then exit;
8231   //DebugLn(['TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection ']);
8232   UsesNode:=FindMainUsesNode;
8233 
8234   // remove units, that are already in the uses section
8235   CurSourceName:=GetSourceName(false);
8236   RemoveNewMainUsesSectionUnit(PChar(CurSourceName)); // the unit itself
8237   if UsesNode<>nil then begin
8238     MoveCursorToNodeStart(UsesNode);
8239     ReadNextAtom; // read 'uses'
8240     repeat
8241       ReadNextAtom; // read name
8242       if AtomIsChar(';') then break;
8243       RemoveNewMainUsesSectionUnit(@Src[CurPos.StartPos]);
8244       if fNewMainUsesSectionUnits.Count=0 then exit;
8245       ReadNextAtom;
8246       if UpAtomIs('IN') then begin
8247         ReadNextAtom;
8248         ReadNextAtom;
8249       end;
8250       while AtomIsChar('.') do
8251       begin
8252         ReadNextAtom;
8253         ReadNextAtom;
8254       end;
8255       if AtomIsChar(';') then break;
8256       if not AtomIsChar(',') then break;
8257     until (CurPos.StartPos>SrcLen);
8258   end;
8259 
8260   // add units
8261   NewUsesTerm:='';
8262   AVLNode:=fNewMainUsesSectionUnits.FindLowest;
8263   while AVLNode<>nil do begin
8264     if NewUsesTerm<>'' then
8265       NewUsesTerm:=NewUsesTerm+', ';
8266     NewUnitName:=GetIdentifier(PChar(AVLNode.Data));
8267     //DebugLn(['TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection NewUnitName=',NewUnitName]);
8268     NewUsesTerm:=NewUsesTerm+NewUnitName;
8269     AVLNode:=fNewMainUsesSectionUnits.FindSuccessor(AVLNode);
8270   end;
8271   if UsesNode<>nil then begin
8272     // add unit to existing uses section
8273     MoveCursorToNodeStart(UsesNode); // for nice error position
8274     InsertPos:=UsesNode.EndPos-1; // position of semicolon at end of uses section
8275     NewUsesTerm:=', '+NewUsesTerm;
8276     if not FSourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,
8277                                       NewUsesTerm) then exit;
8278   end else begin
8279     // create a new uses section
8280     if Tree.Root=nil then exit;
8281     SectionNode:=Tree.Root;
8282     MoveCursorToNodeStart(SectionNode);
8283     ReadNextAtom;
8284     if UpAtomIs('UNIT') then begin
8285       // search interface
8286       SectionNode:=SectionNode.NextBrother;
8287       if (SectionNode=nil) or (SectionNode.Desc<>ctnInterface) then exit;
8288       MoveCursorToNodeStart(SectionNode);
8289       ReadNextAtom;
8290     end;
8291     InsertPos:=CurPos.EndPos;
8292     NewUsesTerm:=FSourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
8293                  +' '+NewUsesTerm+';';
8294     if not FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
8295                                      InsertPos,InsertPos,NewUsesTerm) then exit;
8296   end;
8297 end;
8298 
FindClassMethodsCommentnull8299 function TCodeCompletionCodeTool.FindClassMethodsComment(StartPos: integer; out
8300   CommentStart, CommentEnd: integer): boolean;
8301 var
8302   Code: String;
8303 begin
8304   Result:=false;
8305   Code:=ExtractClassName(CodeCompleteClassNode,false);
8306   // search the comment
8307   Result:=FindCommentInFront(StartPos,Code,false,false,false,true,true,
8308                              CommentStart,CommentEnd)
8309 end;
8310 
8311 procedure TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs(
8312   ClassProcs: TAVLTree;  const TheClassName: string);
8313 var ANodeExt: TCodeTreeNodeExtension;
8314   NewNodeExt: TCodeTreeNodeExtension;
8315   Beauty: TBeautifyCodeOptions;
8316 begin
8317   {$IFDEF CTDEBUG}
8318   DebugLn('[TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs]');
8319   {$ENDIF}
8320   // add new property access methods to ClassProcs
8321   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8322   ANodeExt:=FirstInsert;
8323   while ANodeExt<>nil do begin
8324     if not NodeExtIsVariable(ANodeExt) then begin
8325       if FindNodeExtInTree(ClassProcs,ANodeExt.Txt)=nil then begin
8326         NewNodeExt:=TCodeTreeNodeExtension.Create;
8327         with NewNodeExt do begin
8328           Txt:=UpperCaseStr(TheClassName)+'.'+ANodeExt.Txt; // Name+ParamTypeList
8329           ExtTxt1:=Beauty.AddClassAndNameToProc(
8330              ANodeExt.ExtTxt1,TheClassName,''); // complete proc head code
8331           ExtTxt3:=ANodeExt.ExtTxt3;
8332           Position:=ANodeExt.Position;
8333           {$IFDEF CTDEBUG}
8334           DebugLn('  Txt="',Txt,'"');
8335           DebugLn('  ExtTxt1="',ExtTxt1,'"');
8336           DebugLn('  ExtTxt3="',ExtTxt3,'"');
8337           {$ENDIF}
8338         end;
8339         ClassProcs.Add(NewNodeExt);
8340       end;
8341     end;
8342     ANodeExt:=ANodeExt.Next;
8343   end;
8344 end;
8345 
TCodeCompletionCodeTool.UpdateProcBodySignaturenull8346 function TCodeCompletionCodeTool.UpdateProcBodySignature(
8347   ProcBodyNodes: TAVLTree; const BodyNodeExt: TCodeTreeNodeExtension;
8348   ProcAttrCopyDefToBody: TProcHeadAttributes; var ProcsCopied: boolean;
8349   CaseSensitive: boolean): boolean;
8350 var
8351   OldProcCode: String;
8352   NewProcCode: String;
8353   InsertEndPos: LongInt;
8354   BodyProcHeadNode: TCodeTreeNode;
8355   Indent: LongInt;
8356   InsertPos: LongInt;
8357   DefNodeExt: TCodeTreeNodeExtension;
8358   Beauty: TBeautifyCodeOptions;
8359 begin
8360   Result:=true;
8361   DefNodeExt:=TCodeTreeNodeExtension(BodyNodeExt.Data);
8362   if DefNodeExt=nil then exit;
8363   // this body has a definition
8364   // compare body and definition
8365   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8366   NewProcCode:=ExtractProcHead(DefNodeExt.Node, ProcAttrCopyDefToBody);
8367   BodyProcHeadNode:=BodyNodeExt.Node.FirstChild;
8368   InsertPos:=BodyNodeExt.Node.StartPos;
8369   InsertEndPos:=BodyProcHeadNode.EndPos;
8370   Indent:=Beauty.GetLineIndent(Src, InsertPos);
8371   NewProcCode:=Beauty.BeautifyProc(NewProcCode, Indent, false);
8372   OldProcCode:=ExtractProcHead(BodyNodeExt.Node, ProcAttrCopyDefToBody);
8373   if CompareTextIgnoringSpace(NewProcCode, OldProcCode, CaseSensitive)<>0 then begin
8374     // update body
8375     //debugln(['TCodeCompletionCodeTool.UpdateProcBodySignatures Old="',dbgstr(OldProcCode),'" New="',dbgstr(NewProcCode),'"']);
8376     ProcsCopied:=true;
8377     if not FSourceChangeCache.Replace(gtNone, gtNone, InsertPos,
8378       InsertEndPos, NewProcCode) then
8379       exit(false);
8380   end;
8381   // update body signature in tree,
8382   // so that no new body is created for this definition
8383   ProcBodyNodes.RemovePointer(BodyNodeExt);
8384   BodyNodeExt.Txt:=DefNodeExt.Txt;
8385   ProcBodyNodes.Add(BodyNodeExt);
8386 end;
8387 
8388 procedure TCodeCompletionCodeTool.CheckForOverrideAndAddInheritedCode(
8389   ANodeExt: TCodeTreeNodeExtension; Indent: integer);
8390 // check for 'override' directive and add 'inherited' code to body
8391 var
8392   ProcCode, ProcCall: string;
8393   ProcNode, ClassNode: TCodeTreeNode;
8394   i: integer;
8395   InclProcCall: Boolean;
8396   Beauty: TBeautifyCodeOptions;
8397   Params: TFindDeclarationParams;
8398   Tool: TFindDeclarationTool;
8399 begin
8400   if not AddInheritedCodeToOverrideMethod then exit;
8401   {$IFDEF CTDEBUG}
8402   DebugLn('[TCodeCompletionCodeTool.CheckForOverrideAndAddInheritedCode]');
8403   {$ENDIF}
8404   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8405   ProcNode:=ANodeExt.Node;
8406   if (ProcNode=nil) and (ANodeExt.ExtTxt3<>'') then Exit;
8407   InclProcCall:=False;
8408   if (ProcNodeHasSpecifier(ProcNode,psOVERRIDE)) then begin
8409     // Check for ancestor abstract method.
8410     Params:=TFindDeclarationParams.Create;
8411     try
8412       ClassNode:=CodeCompleteClassNode;
8413       Tool:=Self;
8414       while Tool.FindAncestorOfClass(ClassNode,Params,True) do begin
8415         Tool:=Params.NewCodeTool;
8416         ClassNode:=Params.NewNode;
8417         Params.ContextNode:=ClassNode;
8418         Params.IdentifierTool:=Self;
8419         // FirstChild skips keywords 'procedure' or 'function' or 'class procedure'
8420         Params.SetIdentifier(Self,@Src[ProcNode.FirstChild.StartPos],nil);
8421         if Tool.FindIdentifierInContext(Params) then begin
8422           // Found ancestor definition.
8423           if (Params.NewNode<>nil)
8424           and (Params.NewNode.Desc in [ctnProcedure,ctnProcedureHead]) then
8425             InclProcCall:=not Tool.ProcNodeHasSpecifier(Params.NewNode,psABSTRACT);
8426           Break;
8427         end;
8428       end;
8429     finally
8430       Params.Free;
8431     end;
8432     if InclProcCall then begin
8433       ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpAddClassname,
8434                                           phpWithVarModifiers,phpWithParameterNames,
8435                                           phpWithResultType,phpWithCallingSpecs]);
8436       ProcCall:='inherited '+ExtractProcHead(ProcNode,[phpWithoutClassName,
8437                                         phpWithParameterNames,phpWithoutParamTypes]);
8438       for i:=1 to length(ProcCall)-1 do
8439         if ProcCall[i]=';' then
8440           ProcCall[i]:=',';
8441       if ProcCall[length(ProcCall)]<>';' then
8442         ProcCall:=ProcCall+';';
rocNodenull8443       if NodeIsFunction(ProcNode) then
8444         ProcCall:=Beauty.BeautifyIdentifier('Result')+':='+ProcCall;
8445       ProcCode:=ProcCode+Beauty.LineEnd+'begin'+Beauty.LineEnd
8446                      +Beauty.GetIndentStr(Beauty.Indent)+ProcCall+Beauty.LineEnd+'end;';
8447       ProcCode:=Beauty.BeautifyProc(ProcCode,Indent,false);
8448       ANodeExt.ExtTxt3:=ProcCode;
8449     end;
8450   end;
8451 end;
8452 
UpdateProcBodySignaturesnull8453 function TCodeCompletionCodeTool.UpdateProcBodySignatures(ProcDefNodes,
8454   ProcBodyNodes: TAVLTree; ProcAttrCopyDefToBody: TProcHeadAttributes; out
8455   ProcsCopied: boolean; OnlyNode: TCodeTreeNode): boolean;
8456 { ProcDefNodes and ProcBodyNodes were created by GatherProcNodes
8457   trees of TCodeTreeNodeExtension sorted with CompareCodeTreeNodeExt
8458   NodexExt.Data has mapping to ProcBodyNodes extensions, see GuessMethodDefBodyMapping
8459 
8460   Node.Desc = ctnProcedure
8461   Node.Txt = ExtractProcHead(Node,SomeAttributes)
8462 }
8463 var
8464   BodyAVLNode: TAVLTreeNode;
8465   BodyNodeExt: TCodeTreeNodeExtension;
8466   Bodies: TFPList;
8467   i: Integer;
8468   DefNodeExt: TCodeTreeNodeExtension;
8469 begin
8470   Result:=true;
8471   ProcsCopied:=false;
8472   Bodies:=nil;
8473   try
8474     // replace body proc head(s) with def proc head(s)
8475     Bodies:=TFPList.Create;
8476     BodyAVLNode:=ProcBodyNodes.FindLowest;
8477     while BodyAVLNode<>nil do begin
8478       BodyNodeExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8479       BodyAVLNode:=ProcBodyNodes.FindSuccessor(BodyAVLNode);
8480       DefNodeExt:=TCodeTreeNodeExtension(BodyNodeExt.Data);
8481       if DefNodeExt=nil then continue;
8482       if (OnlyNode=nil) or (OnlyNode=DefNodeExt.Node)
8483       or (OnlyNode.HasAsParent(DefNodeExt.Node)) then
8484         Bodies.Add(BodyNodeExt);
8485     end;
8486     for i:=0 to Bodies.Count-1 do begin
8487       BodyNodeExt:=TCodeTreeNodeExtension(Bodies[i]);
8488       if not UpdateProcBodySignature(ProcBodyNodes, BodyNodeExt,
8489         ProcAttrCopyDefToBody, ProcsCopied,
8490         FSourceChangeCache.BeautifyCodeOptions.UpdateOtherProcSignaturesCase)
8491       then
8492         exit(false);
8493     end;
8494   finally
8495     FreeAndNil(Bodies);
8496     ClearNodeExtData(ProcBodyNodes);
8497     ClearNodeExtData(ProcDefNodes);
8498   end;
8499 end;
8500 
8501 procedure TCodeCompletionCodeTool.GuessProcDefBodyMapping(ProcDefNodes,
8502   ProcBodyNodes: TAVLTree; MapByNameOnly, MapLastOne: boolean);
8503 { ProcDefNodes and ProcBodyNodes are trees of TCodeTreeNodeExtension
8504   ProcDefNodes Data points to mapped ProcBodyNodes nodes
8505 }
8506 
8507   procedure MapBodiesAndDefsByNameAndParams;
8508   var
8509     BodyAVLNode: TAVLTreeNode;
8510     BodyNodeExt: TCodeTreeNodeExtension;
8511     DefAVLNode: TAVLTreeNode;
8512   begin
8513     BodyAVLNode:=ProcBodyNodes.FindLowest;
8514     while BodyAVLNode<>nil do begin
8515       BodyNodeExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8516       if BodyNodeExt.Data=nil then begin
8517         DefAVLNode:=ProcDefNodes.Find(BodyNodeExt);
8518         if DefAVLNode<>nil then begin
8519           // exact match => connect
8520           BodyNodeExt.Data:=DefAVLNode.Data;
8521           TCodeTreeNodeExtension(DefAVLNode.Data).Data:=BodyNodeExt;
8522         end else begin
8523           {$IFDEF VerboseUpdateProcBodySignatures}
8524           debugln(['  MapBodiesAndDefsByNameAndParams has no exact match definition: '+BodyNodeExt.Txt]);
8525           {$ENDIF}
8526         end;
8527       end;
8528       BodyAVLNode:=ProcBodyNodes.FindSuccessor(BodyAVLNode);
8529     end;
8530   end;
8531 
CreateNameTreenull8532   function CreateNameTree(NodeExtTree: TAVLTree; SkipNodesWithData: boolean): TAVLTree;
8533   var
8534     AVLNodeExt: TAVLTreeNode;
8535     ProcNode: TCodeTreeNode;
8536     NodeExt: TCodeTreeNodeExtension;
8537     NewNodeExt: TCodeTreeNodeExtension;
8538   begin
8539     Result:=nil;
8540     if NodeExtTree=nil then exit;
8541     AVLNodeExt:=NodeExtTree.FindLowest;
8542     while AVLNodeExt<>nil do begin
8543       NodeExt:=TCodeTreeNodeExtension(AVLNodeExt.Data);
8544       AVLNodeExt:=NodeExtTree.FindSuccessor(AVLNodeExt);
8545       if (not SkipNodesWithData) or (NodeExt.Data=nil)
8546       or (ProcNodeHasSpecifier(NodeExt.Node,psEXTERNAL)) then begin
8547         {$IFDEF VerboseUpdateProcBodySignatures}
8548         if NodeExtTree=ProcBodyNodes then
8549           debugln(['CreateNameTree body without corresponding def: ',NodeExt.Txt])
8550         else
8551           debugln(['CreateNameTree def without corresponding body: ',NodeExt.Txt]);
8552         {$ENDIF}
8553         ProcNode:=NodeExt.Node;
8554         NewNodeExt:=TCodeTreeNodeExtension.Create;
8555         NewNodeExt.Node:=ProcNode;
8556         NewNodeExt.Txt:=ExtractProcName(ProcNode,[phpWithoutClassName]);
8557         NewNodeExt.Data:=NodeExt;
8558         NewNodeExt.Flags:=Integer(ExtractProcedureGroup(ProcNode));
8559         if Result=nil then
8560           Result:=TAVLTree.Create(@CompareCodeTreeNodeExtMethodHeaders);
8561         Result.Add(NewNodeExt);
8562       end;
8563     end;
8564   end;
8565 
8566   procedure MapBodiesAndDefsByName;
8567   var
8568     BodyNodesByName, DefNodesByName: TAVLTree;
8569     BodyAVLNode: TAVLTreeNode;
8570     LastBodySameName: TAVLTreeNode;
8571     FirstDefSameName: TAVLTreeNode;
8572     LastDefSameName: TAVLTreeNode;
8573     ProcBodyExt: TCodeTreeNodeExtension;
8574     DefExt: TCodeTreeNodeExtension;
8575     DefNameExt: TCodeTreeNodeExtension;
8576     ProcBodyByNameExt: TCodeTreeNodeExtension;
8577   begin
8578     BodyNodesByName:=nil;
8579     DefNodesByName:=nil;
8580     try
8581       // create a tree of proc names and nodes, that were not yet mapped
8582       // one for the bodies ...
8583       BodyNodesByName:=CreateNameTree(ProcBodyNodes,true);
8584       if BodyNodesByName=nil then exit;
8585       // ... and one for the definitions
8586       DefNodesByName:=CreateNameTree(ProcDefNodes,true);
8587       if DefNodesByName=nil then exit;
8588       // check each body if it can be mapped bijective by name
8589       BodyAVLNode:=BodyNodesByName.FindLowest;
8590       while BodyAVLNode<>nil do begin
8591         ProcBodyByNameExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8592         ProcBodyExt:=TCodeTreeNodeExtension(ProcBodyByNameExt.Data);
8593         LastBodySameName:=BodyNodesByName.FindRightMostSameKey(BodyAVLNode);
8594         if LastBodySameName<>BodyAVLNode then begin
8595           // multiple bodies with same name => skip
8596           {$IFDEF VerboseUpdateProcBodySignatures}
8597           debugln(['  MapBodiesAndDefsByName multiple definitionless bodies with same name:']);
8598           repeat
8599             ProcBodyByNameExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8600             ProcBodyExt:=TCodeTreeNodeExtension(ProcBodyByNameExt.Data);
8601             debugln(['    '+ProcBodyExt.Txt]);
8602             BodyAVLNode:=BodyNodesByName.FindSuccessor(BodyAVLNode);
8603           until BodyAVLNode<>LastBodySameName;
8604           {$ENDIF}
8605           BodyAVLNode:=LastBodySameName;
8606         end else begin
8607           // there is only one body with this name that has no exact definition
8608           // => search in definitions
8609           FirstDefSameName:=DefNodesByName.FindLeftMost(ProcBodyByNameExt);
8610           if FirstDefSameName<>nil then begin
8611             // there is at least one definition with this name and without a body
8612             DefNameExt:=TCodeTreeNodeExtension(FirstDefSameName.Data);
8613             DefExt:=TCodeTreeNodeExtension(DefNameExt.Data);
8614             LastDefSameName:=DefNodesByName.FindRightMostSameKey(FirstDefSameName);
8615             if LastDefSameName=FirstDefSameName then begin
8616               // there is exactly one definition with this name and without a body
8617               // => connect
8618               ProcBodyExt.Data:=DefExt;
8619               DefExt.Data:=ProcBodyExt;
8620             end else begin
8621               {$IFDEF VerboseUpdateProcBodySignatures}
8622               debugln(['  MapBodiesAndDefsByName multiple bodyless definitions with same name: ']);
8623               repeat
8624                 DefNameExt:=TCodeTreeNodeExtension(FirstDefSameName.Data);
8625                 DefExt:=TCodeTreeNodeExtension(DefNameExt.Data);
8626                 debugln(['    '+DefExt.Txt]);
8627                 FirstDefSameName:=DefNodesByName.FindSuccessor(FirstDefSameName);
8628               until FirstDefSameName=LastDefSameName;
8629               {$ENDIF}
8630             end;
8631           end;
8632         end;
8633         BodyAVLNode:=BodyNodesByName.FindSuccessor(BodyAVLNode);
8634       end;
8635     finally
8636       if BodyNodesByName<>nil then begin
8637         BodyNodesByName.FreeAndClear;
8638         BodyNodesByName.Free;
8639       end;
8640       if DefNodesByName<>nil then begin
8641         DefNodesByName.FreeAndClear;
8642         DefNodesByName.Free;
8643       end;
8644     end;
8645   end;
8646 
GetNodeExtWithoutDatanull8647   function GetNodeExtWithoutData(Tree: TAVLTree; out Count: integer
8648     ): TCodeTreeNodeExtension;
8649   var
8650     AVLNode: TAVLTreeNode;
8651     NodeExt: TCodeTreeNodeExtension;
8652   begin
8653     Result:=nil;
8654     Count:=0;
8655     AVLNode:=Tree.FindLowest;
8656     while AVLNode<>nil do begin
8657       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
8658       if NodeExt.Data=nil then begin
8659         inc(Count);
8660         Result:=NodeExt;
8661       end;
8662       AVLNode:=Tree.FindSuccessor(AVLNode);
8663     end;
8664   end;
8665 
8666   procedure MapLastBodyAndDef;
8667   var
8668     BodyNodeExt: TCodeTreeNodeExtension;
8669     Cnt: integer;
8670     DefNodeExt: TCodeTreeNodeExtension;
8671   begin
8672     BodyNodeExt:=GetNodeExtWithoutData(ProcBodyNodes,Cnt);
8673     if Cnt>1 then debugln(['Note: TCodeCompletionCodeTool.UpdateProcBodySignatures.MapLastBodyAndDef multiple bodies which can not be mapped to definitions']);
8674     if Cnt<>1 then exit;
8675     DefNodeExt:=GetNodeExtWithoutData(ProcDefNodes,Cnt);
8676     if Cnt>1 then debugln(['Note: TCodeCompletionCodeTool.UpdateProcBodySignatures.MapLastBodyAndDef multiple definitions which can not be mapped to bodies']);
8677     if Cnt<>1 then exit;
8678     BodyNodeExt.Data:=DefNodeExt;
8679     DefNodeExt.Data:=BodyNodeExt;
8680   end;
8681 
8682 begin
8683   {$IFDEF VerboseUpdateProcBodySignatures}
8684   debugln(['TCodeCompletionCodeTool.GuessProcDefBodyMapping',
8685     ' ProcDefNodes=',ProcDefNodes.Count,
8686     ' ProcBodyNodes=',ProcBodyNodes.Count,
8687     ' MapByNameOnly=',MapByNameOnly,
8688     ' MapLastOne=',MapLastOne
8689     ]);
8690   {$ENDIF}
8691   ClearNodeExtData(ProcBodyNodes);
8692   ClearNodeExtData(ProcDefNodes);
8693   MapBodiesAndDefsByNameAndParams; // first: map all exact matches between bodies and defs
8694   if MapByNameOnly then
8695     MapBodiesAndDefsByName; // second: map remaining by name without params
8696   if MapLastOne then
8697     MapLastBodyAndDef; // last: map if there is exactly one unmatching body and def
8698 end;
8699 
TCodeCompletionCodeTool.GatherClassProcDefinitionsnull8700 function TCodeCompletionCodeTool.GatherClassProcDefinitions(
8701   ClassNode: TCodeTreeNode; RemoveAbstracts: boolean): TAVLTree;
8702 var
8703   AnAVLNode: TAVLTreeNode;
8704   NextAVLNode: TAVLTreeNode;
8705   ANodeExt: TCodeTreeNodeExtension;
8706   ANode: TCodeTreeNode;
8707 begin
8708   Result:=GatherProcNodes(ClassNode.FirstChild,
8709              [phpInUpperCase,phpAddClassName],ExtractClassName(ClassNode,true));
8710   if RemoveAbstracts then begin
8711     AnAVLNode:=Result.FindLowest;
8712     while AnAVLNode<>nil do begin
8713       NextAVLNode:=Result.FindSuccessor(AnAVLNode);
8714       ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
8715       ANode:=ANodeExt.Node;
8716       if (ANode<>nil) and (ANode.Desc=ctnProcedure)
8717       and ProcNodeHasSpecifier(ANode,psABSTRACT) then begin
8718         Result.Delete(AnAVLNode);
8719         ANodeExt.Free;
8720       end;
8721       AnAVLNode:=NextAVLNode;
8722     end;
8723   end;
8724 end;
8725 
GatherClassProcBodiesnull8726 function TCodeCompletionCodeTool.GatherClassProcBodies(ClassNode: TCodeTreeNode
8727   ): TAVLTree;
8728 var
8729   TypeSectionNode: TCodeTreeNode;
8730 begin
8731   TypeSectionNode:=ClassNode.GetTopMostNodeOfType(ctnTypeSection);
8732   Result:=GatherProcNodes(TypeSectionNode,
8733                       [phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
8734                        ExtractClassName(ClassNode,true,true,false));
8735 end;
8736 
TCodeCompletionCodeTool.CreateMissingClassProcBodiesnull8737 function TCodeCompletionCodeTool.CreateMissingClassProcBodies(
8738   UpdateSignatures: boolean): boolean;
8739 const
8740   ProcAttrDefToBody = [phpWithStart,
8741                phpAddClassname,phpWithVarModifiers,
8742                phpWithParameterNames,phpWithResultType,
8743                phpWithCallingSpecs,phpWithAssembler];
8744 var
8745   TheClassName: string;
8746   Beauty: TBeautifyCodeOptions;
8747 
8748   procedure InsertProcBody(ANodeExt: TCodeTreeNodeExtension;
8749     InsertPos, Indent: integer);
8750   var ProcCode: string;
8751   begin
8752     if ANodeExt.ExtTxt3<>'' then
8753       ProcCode:=ANodeExt.ExtTxt3
8754     else
8755       ProcCode:=ANodeExt.ExtTxt1;
8756     ProcCode:=Beauty.AddClassAndNameToProc(ProcCode,TheClassName,'');
8757     {$IFDEF CTDEBUG}
8758     DebugLn('CreateMissingClassProcBodies InsertProcBody ',TheClassName,' "',ProcCode,'"');
8759     {$ENDIF}
8760     ProcCode:=Beauty.BeautifyProc(ProcCode,Indent,ANodeExt.ExtTxt3='');
8761     FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,ProcCode);
8762     if FJumpToProcHead.Name='' then begin
8763       // remember one proc body to jump to after the completion
8764       FJumpToProcHead.Name:=ANodeExt.Txt;
8765       FJumpToProcHead.Group:=TPascalMethodGroup(ANodeExt.Flags);
8766       FJumpToProcHead.ResultType:=ANodeExt.ExtTxt4;
8767       if System.Pos('.',FJumpToProcHead.Name)<1 then
8768         FJumpToProcHead.Name:=TheClassName+'.'+FJumpToProcHead.Name;
8769       if FJumpToProcHead.Name[length(FJumpToProcHead.Name)]<>';' then
8770         FJumpToProcHead.Name:=FJumpToProcHead.Name+';';
8771       {$IFDEF CTDEBUG}
8772       DebugLn('CreateMissingClassProcBodies FJumpToProcHead.Name="',FJumpToProcHead.Name,'"');
8773       {$ENDIF}
8774     end;
8775   end;
8776 
8777   procedure CreateCodeForMissingProcBody(TheNodeExt: TCodeTreeNodeExtension;
8778     Indent: integer);
8779   var
8780     ANode: TCodeTreeNode;
8781     ProcCode: string;
8782   begin
8783     CheckForOverrideAndAddInheritedCode(TheNodeExt,Indent);
8784     if (TheNodeExt.ExtTxt1='') and (TheNodeExt.ExtTxt3='') then begin
8785       ANode:=TheNodeExt.Node;
8786       if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
8787         ProcCode:=ExtractProcHead(ANode,ProcAttrDefToBody);
8788         //debugln(['CreateCodeForMissingProcBody Definition="',ProcCode,'"']);
8789         TheNodeExt.ExtTxt3:=Beauty.BeautifyProc(ProcCode,Indent,true);
8790         //debugln(['CreateCodeForMissingProcBody Beautified="',TheNodeExt.ExtTxt3,'"']);
8791       end;
8792     end;
8793   end;
8794 
8795 var
8796   ProcBodyNodes, ClassProcs: TAVLTree;
8797   ANodeExt, ANodeExt2: TCodeTreeNodeExtension;
8798   ExistingNode, MissingNode, AnAVLNode, NextAVLNode,
8799   NearestAVLNode: TAVLTreeNode;
8800   cmp, MissingNodePosition: integer;
8801   FirstExistingProcBody, LastExistingProcBody, ImplementationNode,
8802   ANode, ANode2: TCodeTreeNode;
8803   ClassStartComment, s: string;
8804   Caret1, Caret2: TCodeXYPosition;
8805   MethodInsertPolicy: TMethodInsertPolicy;
8806   NearestNodeValid: boolean;
8807 
8808   procedure FindTopMostAndBottomMostProcBodies;
8809   begin
8810     ExistingNode:=ProcBodyNodes.FindLowest;
8811     if ExistingNode<>nil then
8812       LastExistingProcBody:=TCodeTreeNodeExtension(ExistingNode.Data).Node
8813     else
8814       LastExistingProcBody:=nil;
8815     FirstExistingProcBody:=LastExistingProcBody;
8816     while ExistingNode<>nil do begin
8817       ANode:=TCodeTreeNodeExtension(ExistingNode.Data).Node;
8818       if ANode.StartPos<FirstExistingProcBody.StartPos then
8819         FirstExistingProcBody:=ANode;
8820       if ANode.StartPos>LastExistingProcBody.StartPos then
8821         LastExistingProcBody:=ANode;
8822       //DebugLn(['FindTopMostAndBottomMostProcBodies ',TCodeTreeNodeExtension(ExistingNode.Data).Txt]);
8823       ExistingNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
8824     end;
8825   end;
8826 
8827   procedure CheckForDoubleDefinedMethods;
8828   begin
8829     AnAVLNode:=ClassProcs.FindLowest;
8830     while AnAVLNode<>nil do begin
8831       NextAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
8832       if NextAVLNode<>nil then begin
8833         ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
8834         ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
8835         if CompareCodeTreeNodeExtMethodHeaders(ANodeExt, ANodeExt2) = 0 then
8836         begin
8837           // proc redefined -> error
8838           if ANodeExt.Node.StartPos>ANodeExt2.Node.StartPos then begin
8839             ANode:=ANodeExt.Node;
8840             ANode2:=ANodeExt2.Node;
8841           end else begin
8842             ANode:=ANodeExt2.Node;
8843             ANode2:=ANodeExt.Node;
8844           end;
8845           debugln(['CheckForDoubleDefinedMethods redefined']);
8846           debugln('  1. ',ANodeExt.Txt,' ',CleanPosToStr(ANodeExt.Node.StartPos));
8847           debugln('  2. ',ANodeExt2.Txt,' ',CleanPosToStr(ANodeExt2.Node.StartPos));
8848           CleanPosToCaret(ANode.FirstChild.StartPos,Caret1);
8849           CleanPosToCaret(ANode2.FirstChild.StartPos,Caret2);
8850           s:=IntToStr(Caret2.Y)+','+IntToStr(Caret2.X);
8851           if Caret1.Code<>Caret2.Code then
8852             s:=s+' in '+CreateRelativePath(Caret2.Code.Filename,ExtractFilePath(Caret1.Code.Filename));
8853           MoveCursorToNodeStart(ANode.FirstChild);
8854           RaiseException(20170421201808,'procedure redefined (first at '+s+')');
8855         end;
8856       end;
8857       AnAVLNode:=NextAVLNode;
8858     end;
8859   end;
8860 
8861   procedure FindInsertPointForNewClass(out InsertPos, Indent: LongInt);
8862 
8863     procedure SetIndentAndInsertPos(Node: TCodeTreeNode; Behind: boolean);
8864     begin
8865       Indent:=Beauty.GetLineIndent(Src,Node.StartPos);
8866       if Behind then
8867         InsertPos:=FindLineEndOrCodeAfterPosition(Node.EndPos)
8868       else
8869         InsertPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
8870     end;
8871 
8872   var
8873     StartSearchProc: TCodeTreeNode;
8874     NearestProcNode: TCodeTreeNode;
8875     UnitInterfaceNode: TCodeTreeNode;
8876   begin
8877     InsertPos:=0;
8878     Indent:=0;
8879     ImplementationNode:=FindImplementationNode;
8880     StartSearchProc:=nil;
8881     UnitInterfaceNode:=FindInterfaceNode;
8882     if (UnitInterfaceNode<>nil)
8883     and CodeCompleteClassNode.HasAsParent(UnitInterfaceNode) then begin
8884       // class is in interface section
8885       // -> insert at the end of the implementation section
8886       if ImplementationNode=nil then begin
8887         // create implementation section
8888         InsertPos:=UnitInterfaceNode.EndPos;
8889         Indent:=Beauty.GetLineIndent(Src,UnitInterfaceNode.StartPos);
8890         if not CodeCompleteSrcChgCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
8891           CodeCompleteSrcChgCache.BeautifyCodeOptions.BeautifyKeyWord('implementation'))
8892         then begin
8893           MoveCursorToCleanPos(InsertPos);
8894           RaiseException(20170421201812,'unable to insert implementation section (read only?)');
8895         end;
8896         exit;
8897       end else if (ImplementationNode.FirstChild=nil)
8898       or (ImplementationNode.FirstChild.Desc=ctnBeginBlock) then begin
8899         // implementation is empty
8900         Indent:=Beauty.GetLineIndent(Src,ImplementationNode.StartPos);
8901         if ImplementationNode.FirstChild<>nil then
8902           InsertPos:=ImplementationNode.FirstChild.StartPos
8903         else
8904           InsertPos:=ImplementationNode.EndPos;
8905         exit;
8906       end;
8907       StartSearchProc:=ImplementationNode.FirstChild;
8908     end else begin
8909       // class is not in interface section
8910       StartSearchProc:=CodeCompleteClassNode.GetTopMostNodeOfType(ctnTypeSection);
8911     end;
8912     case Beauty.ForwardProcBodyInsertPolicy of
8913     fpipInFrontOfMethods:
8914       begin
8915         // Try to insert new proc in front of existing methods
8916 
8917         // find first method
8918         NearestProcNode:=StartSearchProc;
8919         while (NearestProcNode<>nil) and (NearestProcNode.Desc<>ctnBeginBlock)
8920         and (not NodeIsMethodBody(NearestProcNode)) do
8921           NearestProcNode:=NearestProcNode.NextBrother;
8922         if NearestProcNode<>nil then begin
8923           // the comments in front of the first method probably belong to the class
8924           // Therefore insert behind the node in front of the first method
8925           Indent:=Beauty.GetLineIndent(Src,NearestProcNode.StartPos);
8926           if NearestProcNode.PriorBrother<>nil then begin
8927             InsertPos:=FindLineEndOrCodeAfterPosition(NearestProcNode.PriorBrother.EndPos);
8928           end else begin
8929             InsertPos:=NearestProcNode.Parent.StartPos;
8930             while (InsertPos<=NearestProcNode.StartPos)
8931             and (not IsSpaceChar[Src[InsertPos]]) do
8932               inc(InsertPos);
8933           end;
8934           InsertPos:=SkipResourceDirective(InsertPos);
8935           exit;
8936         end;
8937       end;
8938     fpipBehindMethods:
8939       begin
8940         // Try to insert new proc behind existing methods
8941 
8942         // find last method (go to last brother and search backwards)
8943         if (StartSearchProc<>nil) and (StartSearchProc.Parent<>nil) then
8944           NearestProcNode:=StartSearchProc.Parent.LastChild
8945         else
8946           NearestProcNode:=nil;
8947         while (NearestProcNode<>nil) and (not NodeIsMethodBody(NearestProcNode)) do
8948           NearestProcNode:=NearestProcNode.PriorBrother;
8949         if NearestProcNode<>nil then begin
8950           SetIndentAndInsertPos(NearestProcNode,NearestProcNode.Desc<>ctnBeginBlock);
8951           InsertPos:=SkipResourceDirective(InsertPos);
8952           exit;
8953         end;
8954       end;
8955     end;
8956 
8957     // Default position: Insert behind last node
8958     if (StartSearchProc<>nil)
8959     and (StartSearchProc.Parent<>nil) then begin
8960       NearestProcNode:=StartSearchProc.Parent.LastChild;
8961       if NearestProcNode.Desc=ctnBeginBlock then
8962         NearestProcNode:=NearestProcNode.PriorBrother;
8963     end;
8964     if NearestProcNode<>nil then begin
8965       Indent:=0;
8966       SetIndentAndInsertPos(NearestProcNode,true);
8967       InsertPos:=SkipResourceDirective(InsertPos);
8968       exit;
8969     end;
8970 
8971     RaiseException(20170421201815,'TCodeCompletionCodeTool.CreateMissingClassProcBodies.FindInsertPointForNewClass '
8972      +' Internal Error: no insert position found');
8973   end;
8974 
8975   procedure InsertClassMethodsComment(InsertPos, Indent: integer);
8976   var
8977     CommentStartPos: integer;
8978     CommentEndPos: integer;
8979   begin
8980     // insert class comment
8981     if ClassProcs.Count=0 then exit;
8982     if not Beauty.ClassImplementationComments
8983     then
8984       exit;
8985     // find the start of the class (the position in front of the class name)
8986     // check if there is already a comment in front
8987     if FindClassMethodsComment(InsertPos,CommentStartPos,CommentEndPos) then begin
8988       // comment already exists
8989       exit;
8990     end;
8991     ClassStartComment:=Beauty.GetIndentStr(Indent)
8992                        +'{ '+ExtractClassName(CodeCompleteClassNode,false)+' }';
8993     FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
8994                                ClassStartComment);
8995   end;
8996 
8997 var
8998   InsertPos: integer;
8999   Indent: integer;
9000   ProcsCopied: boolean;
9001   OnlyNode: TCodeTreeNode;
9002 begin
9003   {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9004   DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies Gather existing method bodies ... ');
9005   {$ENDIF}
9006   if CodeCompleteClassNode.Desc in AllClassInterfaces then begin
9007     // interfaces have no implementations
9008     {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9009     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies interface ',CodeCompleteClassNode.DescAsString]);
9010     {$ENDIF}
9011     exit(true);
9012   end;
9013   if FindClassExternalNode(CodeCompleteClassNode)<>nil then begin
9014     // external class has no implementations
9015     {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9016     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies external ',CodeCompleteClassNode.DescAsString]);
9017     {$ENDIF}
9018     exit(true);
9019   end;
9020 
9021   Result:=false;
9022   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
9023   MethodInsertPolicy:=Beauty.MethodInsertPolicy;
9024   // gather existing class proc bodies
9025   ClassProcs:=nil;
9026   ProcBodyNodes:=nil;
9027   try
9028     {$IFDEF VerboseCreateMissingClassProcBodies}
9029     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies get class procs of ',CodeCompleteClassNode.DescAsString]);
9030     {$ENDIF}
9031     ClassProcs:=GatherClassProcDefinitions(CodeCompleteClassNode,true);
9032     {$IFDEF VerboseCreateMissingClassProcBodies}
9033     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies get bodies of ',CodeCompleteClassNode.DescAsString]);
9034     {$ENDIF}
9035     ProcBodyNodes:=GatherClassProcBodies(CodeCompleteClassNode);
9036 
9037     {$IFDEF VerboseCreateMissingClassProcBodies}
9038     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ClassProcs=',ClassProcs.Count]);
9039     AnAVLNode:=ClassProcs.FindLowest;
9040     while AnAVLNode<>nil do begin
9041       DebugLn(' Gathered ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9042       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9043     end;
9044     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ProcBodyNodes=',ProcBodyNodes.Count]);
9045     AnAVLNode:=ProcBodyNodes.FindLowest;
9046     while AnAVLNode<>nil do begin
9047       DebugLn(' Gathered ProcBody ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9048       AnAVLNode:=ProcBodyNodes.FindSuccessor(AnAVLNode);
9049     end;
9050     {$ENDIF}
9051 
9052     // find topmost and bottommost proc body
9053     FindTopMostAndBottomMostProcBodies;
9054 
9055     {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9056     DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies Gather existing method declarations ... ');
9057     {$ENDIF}
9058     TheClassName:=ExtractClassName(CodeCompleteClassNode,false,true,Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE]);
9059 
9060     // check for double defined methods in ClassProcs
9061     CheckForDoubleDefinedMethods;
9062 
9063     // check for changed procs
9064     if UpdateSignatures then begin
9065       GuessProcDefBodyMapping(ClassProcs,ProcBodyNodes,true,true);
9066       if Beauty.UpdateAllMethodSignatures then
9067         OnlyNode:=nil
9068       else
9069         OnlyNode:=FCompletingCursorNode;
9070       {$IFDEF VerboseCreateMissingClassProcBodies}
9071       debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies Beauty.UpdateAllMethodSignatures=',Beauty.UpdateAllMethodSignatures,' ',OnlyNode<>nil]);
9072       {$ENDIF}
9073       if not UpdateProcBodySignatures(ClassProcs,ProcBodyNodes,ProcAttrDefToBody,
9074         ProcsCopied,OnlyNode)
9075       then exit;
9076     end;
9077 
9078     // there are new methods
9079 
9080     CurNode:=FirstExistingProcBody;
9081 
9082     {$IFDEF VerboseCreateMissingClassProcBodies}
9083     AnAVLNode:=ClassProcs.FindLowest;
9084     while AnAVLNode<>nil do begin
9085       DebugLn(' SignaturesUpdated ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9086       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9087     end;
9088     {$ENDIF}
9089 
9090     AddNewPropertyAccessMethodsToClassProcs(ClassProcs,TheClassName);
9091 
9092     {$IFDEF VerboseCreateMissingClassProcBodies}
9093     AnAVLNode:=ClassProcs.FindLowest;
9094     while AnAVLNode<>nil do begin
9095       DebugLn(' AfterPropsCompleted ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9096       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9097     end;
9098     {$ENDIF}
9099 
9100     if MethodInsertPolicy=mipClassOrder then begin
9101       // insert in ClassOrder -> get a definition position for every method
9102       AnAVLNode:=ClassProcs.FindLowest;
9103       while AnAVLNode<>nil do begin
9104         ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
9105         if ANodeExt.Position<1 then
9106           // position not set => this proc was already there => there is a node
9107           ANodeExt.Position:=ANodeExt.Node.StartPos;
9108         // find corresponding proc body
9109         NextAVLNode:=ProcBodyNodes.Find(ANodeExt);
9110         if NextAVLNode<>nil then begin
9111           // NextAVLNode.Data is the TCodeTreeNodeExtension for the method body
9112           // (note 1)
9113           ANodeExt.Data:=NextAVLNode.Data;
9114         end;
9115         AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9116       end;
9117       // sort the method definitions with the definition position
9118       ClassProcs.OnCompare:=@CompareCodeTreeNodeExtWithPos;
9119     end;
9120 
9121     {$IFDEF VerboseCreateMissingClassProcBodies}
9122     AnAVLNode:=ClassProcs.FindLowest;
9123     while AnAVLNode<>nil do begin
9124       DebugLn(' BeforeAddMissing ProcDef "',TCodeTreeNodeExtension(AnAVLNode.Data).Txt,'"');
9125       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9126     end;
9127     AnAVLNode:=ProcBodyNodes.FindLowest;
9128     while AnAVLNode<>nil do begin
9129       DebugLn(' BeforeAddMissing ProcBody "',TCodeTreeNodeExtension(AnAVLNode.Data).Txt,'"');
9130       AnAVLNode:=ProcBodyNodes.FindSuccessor(AnAVLNode);
9131     end;
9132     {$ENDIF}
9133 
9134     // search for missing proc bodies
9135     if (ProcBodyNodes.Count=0) then begin
9136       // there were no old proc bodies of the class -> start class
9137       {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9138       DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies Starting class in implementation ');
9139       {$ENDIF}
9140       FindInsertPointForNewClass(InsertPos,Indent);
9141       {$IFDEF VerboseCreateMissingClassProcBodies}
9142       debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies Indent=',Indent,' InsertPos=',dbgstr(copy(Src,InsertPos-10,10)),'|',dbgstr(copy(Src,InsertPos,10))]);
9143       {$ENDIF}
9144       InsertClassMethodsComment(InsertPos,Indent);
9145 
9146       // insert all proc bodies
9147       MissingNode:=ClassProcs.FindHighest;
9148       while (MissingNode<>nil) do begin
9149         ANodeExt:=TCodeTreeNodeExtension(MissingNode.Data);
9150         MissingNode:=ClassProcs.FindPrecessor(MissingNode);
9151         if ProcNodeHasSpecifier(ANodeExt.Node,psEXTERNAL) then continue;
9152         CreateCodeForMissingProcBody(ANodeExt,Indent);
9153         InsertProcBody(ANodeExt,InsertPos,Indent);
9154       end;
9155 
9156     end else begin
9157       // there were old class procs already
9158       // -> search a good Insert Position behind or in front of
9159       //    another proc body of this class
9160       {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9161       DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies  Insert missing bodies between existing ... ClassProcs.Count=',dbgs(ClassProcs.Count));
9162       {$ENDIF}
9163 
9164       // set default insert position
9165       Indent:=Beauty.GetLineIndent(Src,LastExistingProcBody.StartPos);
9166       InsertPos:=FindLineEndOrCodeAfterPosition(LastExistingProcBody.EndPos);
9167 
9168       // check for all defined class methods (MissingNode), if there is a body
9169       MissingNode:=ClassProcs.FindHighest;
9170       NearestNodeValid:=false;
9171       while (MissingNode<>nil) do begin
9172         ANodeExt:=TCodeTreeNodeExtension(MissingNode.Data);
9173         MissingNode:=ClassProcs.FindPrecessor(MissingNode);
9174         ExistingNode:=ProcBodyNodes.Find(ANodeExt);
9175         {$IFDEF VerboseCreateMissingClassProcBodies}
9176         DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Txt,' ExistingNode=',ExistingNode<>nil]);
9177         {$ENDIF}
9178         if (ExistingNode=nil) and (not ProcNodeHasSpecifier(ANodeExt.Node,psEXTERNAL))
9179         then begin
9180           {$IFDEF VerboseCreateMissingClassProcBodies}
9181           //generates AV:
9182           //DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Txt,' ExistingNode=',TCodeTreeNodeExtension(ExistingNode.Data).Txt]);
9183           {$ENDIF}
9184           // MissingNode does not have a body -> insert proc body
9185           case MethodInsertPolicy of
9186           mipAlphabetically:
9187             begin
9188               // search alphabetically nearest proc body
9189               ExistingNode:=ProcBodyNodes.FindNearest(ANodeExt);
9190               cmp:=CompareCodeTreeNodeExtMethodHeaders(ExistingNode.Data,ANodeExt);
9191               if (cmp<0) then begin
9192                 AnAVLNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
9193                 if AnAVLNode<>nil then begin
9194                   ExistingNode:=AnAVLNode;
9195                   cmp:=1;
9196                 end;
9197               end;
9198               ANodeExt2:=TCodeTreeNodeExtension(ExistingNode.Data);
9199               ANode:=ANodeExt2.Node;
9200               Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
9201               if cmp>0 then begin
9202                 // insert behind ExistingNode
9203                 InsertPos:=FindLineEndOrCodeAfterPosition(ANode.EndPos);
9204               end else begin
9205                 // insert in front of ExistingNode
9206                 InsertPos:=FindLineEndOrCodeInFrontOfPosition(ANode.StartPos);
9207               end;
9208             end;
9209 
9210           mipClassOrder:
9211             begin
9212               // search definition-position nearest proc node
9213               MissingNodePosition:=ANodeExt.Position;
9214               if not NearestNodeValid then begin
9215                 // search NearestAVLNode method with body in front of MissingNode
9216                 // and NextAVLNode method with body behind MissingNode
9217                 NearestAVLNode:=nil;
9218                 NextAVLNode:=ClassProcs.FindHighest;
9219                 NearestNodeValid:=true;
9220               end;
9221               while (NextAVLNode<>nil) do begin
9222                 ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
9223                 if ANodeExt2.Data<>nil then begin
9224                   // method has body
9225                   if ANodeExt2.Position>MissingNodePosition then
9226                     break;
9227                   NearestAVLNode:=NextAVLNode;
9228                 end;
9229                 NextAVLNode:=ClassProcs.FindPrecessor(NextAVLNode);
9230               end;
9231               if NearestAVLNode<>nil then begin
9232                 // there is a NearestAVLNode in front -> insert behind body
9233                 ANodeExt2:=TCodeTreeNodeExtension(NearestAVLNode.Data);
9234                 // see above (note 1) for ANodeExt2.Data
9235                 ANode:=TCodeTreeNodeExtension(ANodeExt2.Data).Node;
9236                 Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
9237                 InsertPos:=FindLineEndOrCodeAfterPosition(ANode.EndPos);
9238               end else if NextAVLNode<>nil then begin
9239                 // there is a NextAVLNode behind -> insert in front of body
9240                 ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
9241                 // see above (note 1) for ANodeExt2.Data
9242                 ANode:=TCodeTreeNodeExtension(ANodeExt2.Data).Node;
9243                 Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
9244                 InsertPos:=FindLineEndOrCodeInFrontOfPosition(ANode.StartPos);
9245               end;
9246             end;
9247           end;
9248           CreateCodeForMissingProcBody(ANodeExt,Indent);
9249           InsertProcBody(ANodeExt,InsertPos,0);
9250         end;
9251       end;
9252     end;
9253     Result:=true;
9254   finally
9255     DisposeAVLTree(ClassProcs);
9256     DisposeAVLTree(ProcBodyNodes);
9257   end;
9258 end;
9259 
ApplyChangesAndJumpToFirstNewProcnull9260 function TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc(
9261   CleanPos: integer; OldTopLine: integer; AddMissingProcBodies: boolean; out
9262   NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine,
9263   BlockBottomLine: integer): boolean;
9264 var
9265   OldCodeXYPos: TCodeXYPosition;
9266   OldCodePos: TCodePosition;
9267   CursorNode: TCodeTreeNode;
9268   CurClassName: String;
9269   ProcNode: TCodeTreeNode;
9270 begin
9271   Result:=false;
9272 
9273   try
9274     // extend class declaration
9275     if not InsertAllNewClassParts then
9276       RaiseException(20170421201817,ctsErrorDuringInsertingNewClassParts);
9277 
9278     // create missing method bodies
9279     if AddMissingProcBodies and (not CreateMissingClassProcBodies(true)) then
9280       RaiseException(20170421201819,ctsErrorDuringCreationOfNewProcBodies);
9281 
9282     CurClassName:=ExtractClassName(CodeCompleteClassNode,false);
9283 
9284     // apply the changes and jump to first new proc body
9285     if not CleanPosToCodePos(CleanPos,OldCodePos) then
9286       RaiseException(20170421201822,'TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCodePos');
9287     if not CleanPosToCaret(CleanPos,OldCodeXYPos) then
9288       RaiseException(20170421201826,'TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCaret');
9289     if not FSourceChangeCache.Apply then
9290       RaiseException(20170421201828,ctsUnableToApplyChanges);
9291 
9292   finally
9293     FreeClassInsertionList;
9294   end;
9295 
9296   if FJumpToProcHead.Name<>'' then begin
9297     {$IFDEF CTDEBUG}
9298     DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Jump to new proc body ... "',FJumpToProcHead.Name,'"');
9299     {$ENDIF}
9300     // there was a new proc body
9301     // -> find it and jump to
9302 
9303     // reparse code
9304     BuildTreeAndGetCleanPos(OldCodeXYPos,CleanPos);
9305     // find CodeTreeNode at cursor
9306     CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
9307     // due to insertions in front of the class, the cursor position could
9308     // have changed
9309     if CursorNode<>nil then
9310       CursorNode:=CursorNode.GetTopMostNodeOfType(ctnTypeSection);
9311     FCodeCompleteClassNode:=FindClassNode(CursorNode,CurClassName,true,false);
9312     if CodeCompleteClassNode=nil then
9313       RaiseException(20170421201833,'oops, I lost your class');
9314     ProcNode:=FindProcNode(CursorNode,FJumpToProcHead,[phpInUpperCase,phpIgnoreForwards]);
9315     if ProcNode=nil then begin
9316       debugln(['TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Proc="',FJumpToProcHead.Name,'"']);
9317       RaiseException(20170421201835,ctsNewProcBodyNotFound);
9318     end;
9319     Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
9320   end else begin
9321     {$IFDEF CTDEBUG}
9322     DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Adjust Cursor ... ');
9323     {$ENDIF}
9324     // there was no new proc body
9325     // -> adjust cursor
9326     AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
9327     Result:=true;
9328   end;
9329 end;
9330 
CompleteCodenull9331 function TCodeCompletionCodeTool.CompleteCode(CursorPos: TCodeXYPosition;
9332   OldTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine,
9333   BlockTopLine, BlockBottomLine: integer;
9334   SourceChangeCache: TSourceChangeCache; Interactive: Boolean): boolean;
9335 
TryCompleteLocalVarnull9336   function TryCompleteLocalVar(CleanCursorPos: integer;
9337     CursorNode: TCodeTreeNode): Boolean;
9338   begin
9339     // test if Local variable assignment (i:=3)
9340     Result:=CompleteVariableAssignment(CleanCursorPos,OldTopLine,
9341       CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9342     if Result then exit;
9343 
9344     // test if Local variable iterator (for i in j)
9345     Result:=CompleteVariableForIn(CleanCursorPos,OldTopLine,
9346       CursorNode,NewPos,NewTopLine,SourceChangeCache, Interactive);
9347     if Result then exit;
9348 
9349     // test if undeclared local variable as parameter (GetPenPos(x,y))
9350     Result:=CompleteIdentifierByParameter(CleanCursorPos,OldTopLine,
9351       CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9352     if Result then exit;
9353   end;
9354 
TryCompletenull9355   function TryComplete(CursorNode: TCodeTreeNode; CleanCursorPos: integer): Boolean;
9356   var
9357     ProcNode, AClassNode: TCodeTreeNode;
9358     IsEventAssignment: boolean;
9359   begin
9360     Result := False;
9361     FCompletingCursorNode:=CursorNode;
9362     try
9363 
9364       {$IFDEF CTDEBUG}
9365       DebugLn('TCodeCompletionCodeTool.CompleteCode A CleanCursorPos=',dbgs(CleanCursorPos),' NodeDesc=',NodeDescriptionAsString(CursorNode.Desc));
9366       {$ENDIF}
9367 
9368       // test if in a class
9369       AClassNode:=FindClassOrInterfaceNode(CursorNode);
9370       if AClassNode<>nil then begin
9371         Result:=CompleteClass(AClassNode,CleanCursorPos,OldTopLine,CursorNode,
9372                               NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
9373         exit;
9374       end;
9375       {$IFDEF CTDEBUG}
9376       DebugLn('TCodeCompletionCodeTool.CompleteCode not in-a-class ... ');
9377       {$ENDIF}
9378 
9379       // test if forward proc
9380       //debugln('TCodeCompletionCodeTool.CompleteCode ',CursorNode.DescAsString);
9381       if CursorNode.Desc = ctnInterface then
9382       begin
9383         //Search nearest (to the left) CursorNode if we are within interface section
9384         CursorNode := CursorNode.LastChild;
9385         while Assigned(CursorNode) and (CursorNode.StartPos > CleanCursorPos) do
9386           CursorNode := CursorNode.PriorBrother;
9387         if (CursorNode=nil)
9388         or (not PositionsInSameLine(Src,CursorNode.EndPos,CleanCursorPos)) then
9389           CursorNode:=FCompletingCursorNode;
9390       end;
9391       ProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
9392       if (ProcNode=nil) and (CursorNode.Desc=ctnProcedure) then
9393         ProcNode:=CursorNode;
9394       if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure)
9395       and ((ProcNode.SubDesc and ctnsForwardDeclaration)>0) then begin
9396         // Node is forward Proc
9397         Result:=CompleteForwardProcs(CursorPos,ProcNode,CursorNode,NewPos,NewTopLine,
9398                              BlockTopLine, BlockBottomLine, SourceChangeCache);
9399         exit;
9400       end;
9401 
9402       // test if Event assignment (MyClick:=@Button1.OnClick)
9403       Result:=CompleteEventAssignment(CleanCursorPos,OldTopLine,CursorNode,
9404                              IsEventAssignment,NewPos,NewTopLine,SourceChangeCache,Interactive);
9405       if IsEventAssignment then exit;
9406 
9407       Result:=TryCompleteLocalVar(CleanCursorPos,CursorNode);
9408       if Result then exit;
9409 
9410       // test if procedure call
9411       Result:=CompleteProcByCall(CleanCursorPos,OldTopLine,
9412                                  CursorNode,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,SourceChangeCache);
9413       if Result then exit;
9414     finally
9415       FCompletingCursorNode:=nil;
9416     end;
9417   end;
9418 
TryFirstLocalIdentOccurrencenull9419   function TryFirstLocalIdentOccurrence(CursorNode: TCodeTreeNode;
9420     OrigCleanCursorPos, CleanCursorPos: Integer): boolean;
9421   var
9422     AtomContextNode, StatementNode: TCodeTreeNode;
9423     IdentAtom, LastCurPos: TAtomPosition;
9424     UpIdentifier: string;
9425     LastAtomIsDot: Boolean;
9426     Params: TFindDeclarationParams;
9427     OldCodePos: TCodePosition;
9428   begin
9429     Result := false;
9430 
9431     // get enclosing Begin block
9432     if not (CursorNode.Desc in AllPascalStatements) then exit;
9433     StatementNode:=CursorNode;
9434     while StatementNode<>nil do begin
9435       if (StatementNode.Desc=ctnBeginBlock) then begin
9436         if (StatementNode.Parent.Desc in [ctnProcedure,ctnProgram]) then break;
9437       end else if StatementNode.Desc in [ctnInitialization,ctnFinalization] then
9438         break;
9439       StatementNode:=StatementNode.Parent;
9440     end;
9441     if StatementNode=nil then exit;
9442 
9443     // read UpIdentifier at CleanCursorPos
9444     GetIdentStartEndAtPosition(Src,CleanCursorPos,
9445       IdentAtom.StartPos,IdentAtom.EndPos);
9446     if IdentAtom.StartPos=IdentAtom.EndPos then
9447       Exit;
9448 
9449     MoveCursorToAtomPos(IdentAtom);
9450     if not AtomIsIdentifier then
9451       Exit; // a keyword
9452 
9453     UpIdentifier := GetUpAtom;
9454 
9455     //find first occurrence of UpIdentifier from procedure begin until CleanCursorPos
9456     //we are interested only in local variables/identifiers
9457     //  --> the UpIdentifier must not be preceded by a point ("MyObject.I" - if we want to complete I)
9458     //      and then do another check if it is not available with the "with" command, e.g.
9459     MoveCursorToCleanPos(StatementNode.StartPos);
9460     if StatementNode.Desc=ctnBeginBlock then
9461       BuildSubTreeForBeginBlock(StatementNode);
9462     LastAtomIsDot := False;
9463     while CurPos.EndPos < CleanCursorPos do
9464     begin
9465       ReadNextAtom;
9466       if not LastAtomIsDot and AtomIsIdentifier and UpAtomIs(UpIdentifier) then
9467       begin
9468         AtomContextNode:=FindDeepestNodeAtPos(StatementNode,CurPos.StartPos,true);
9469         Params:=TFindDeclarationParams.Create(Self, AtomContextNode);
9470         try
9471           // check if UpIdentifier doesn't exists (e.g. because of a with statement)
9472           LastCurPos := CurPos;
9473           if not IdentifierIsDefined(CurPos,AtomContextNode,Params) then
9474           begin
9475             FCompletingCursorNode:=CursorNode;
9476             try
9477               if not CleanPosToCodePos(OrigCleanCursorPos,OldCodePos) then
9478                 RaiseException(20170421201838,'TCodeCompletionCodeTool.TryFirstLocalIdentOccurrence CleanPosToCodePos');
9479               CompleteCode:=TryCompleteLocalVar(LastCurPos.StartPos,AtomContextNode);
9480               AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
9481               exit(true);
9482             finally
9483               FCompletingCursorNode:=nil;
9484             end;
9485           end;
9486           CurPos := LastCurPos;//IdentifierIsDefined changes the CurPos
9487         finally
9488           Params.Free;
9489         end;
9490       end;
9491       LastAtomIsDot := CurPos.Flag=cafPoint;
9492     end;
9493   end;
9494 
9495   procedure ClearAndRaise(var E: ECodeToolError; CleanPos: Integer);
9496   var
9497     TempE: ECodeToolError;
9498   begin
9499     TempE := E;
9500     E := nil;
9501     MoveCursorToCleanPos(CleanPos);
9502     RaiseExceptionInstance(TempE);
9503   end;
9504 
9505   function TryAssignment(CursorNode: TCodeTreeNode;
9506     OrigCleanCursorPos, CleanCursorPos: Integer): Boolean;
9507   var
9508     OldCodePos: TCodePosition;
9509   begin
9510     // Search only within the current statement - stop on semicolon or keywords
9511     //   (else isn't prepended by a semicolon in contrast to other keywords).
9512 
9513     Result := False;
9514     MoveCursorToNearestAtom(CleanCursorPos);
9515     while CurPos.StartPos > 1 do
9516     begin
9517       ReadPriorAtom;
9518       case CurPos.Flag of
9519         cafAssignment:
9520         begin
9521           // OK FOUND!
9522           ReadPriorAtom;
9523           FCompletingCursorNode:=CursorNode;
9524           try
9525             if TryComplete(CursorNode, CurPos.StartPos) then
9526             begin
9527               if not CleanPosToCodePos(OrigCleanCursorPos,OldCodePos) then
9528                 RaiseException(20170421201842,'TCodeCompletionCodeTool.CompleteCode CleanPosToCodePos');
9529               AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
9530               exit(true);
9531             end;
9532             break;
9533           finally
9534             FCompletingCursorNode:=nil;
9535           end;
9536         end;
9537         cafWord: // stop on keywords
9538           if UpAtomIs('BEGIN') or UpAtomIs('END')
9539           or UpAtomIs('TRY') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
9540           or UpAtomIs('FOR') or UpAtomIs('TO') or UpAtomIs('DO')
9541           or UpAtomIs('REPEAT') or UpAtomIs('UNTIL') or UpAtomIs('WHILE')
9542           or UpAtomIs('IF') or UpAtomIs('THEN') or UpAtomIs('CASE') or UpAtomIs('ELSE')
9543           then
9544             break;
9545         cafSemicolon:
9546           break; // stop on semicolon
9547       end;
9548     end;
9549   end;
9550 
9551 var
9552   CleanCursorPos, OrigCleanCursorPos: integer;
9553   CursorNode: TCodeTreeNode;
9554   LastCodeToolsErrorCleanPos: Integer;
9555   LastCodeToolsError: ECodeToolError;
9556 begin
9557   BlockTopLine := -1;
9558   BlockBottomLine := -1;
9559   //DebugLn(['TCodeCompletionCodeTool.CompleteCode CursorPos=',Dbgs(CursorPos),' OldTopLine=',OldTopLine]);
9560 
9561   Result:=false;
9562   if (SourceChangeCache=nil) then
9563     RaiseException(20170421201857,'need a SourceChangeCache');
9564   BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
9565                           [btSetIgnoreErrorPos]);
9566   OrigCleanCursorPos:=CleanCursorPos;
9567   NewPos:=CleanCodeXYPosition;
9568   NewTopLine:=0;
9569 
9570   // find CodeTreeNode at cursor
9571   // skip newline chars
9572   while (CleanCursorPos>1) and (Src[CleanCursorPos] in [#10,#13]) do
9573     dec(CleanCursorPos);
9574   // skip space (first try left)
9575   while (CleanCursorPos>1) and (Src[CleanCursorPos] in [' ',#9,';']) do
9576     dec(CleanCursorPos);
9577   if (CleanCursorPos>0) and (CleanCursorPos<SrcLen)
9578   and (Src[CleanCursorPos] in [#10,#13]) then begin
9579     // then try right
9580     repeat
9581       inc(CleanCursorPos);
9582     until (CleanCursorPos>=SrcLen) or (not (Src[CleanCursorPos] in [' ',#9]));
9583   end;
9584 
9585   CodeCompleteSrcChgCache:=SourceChangeCache;
9586   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
9587 
9588   LastCodeToolsError := nil;
9589   try
9590     try
9591       if TryComplete(CursorNode, CleanCursorPos) then
9592         exit(true);
9593 
9594       { Find the first occurrence of the (local) identifier at cursor in current
9595         procedure body and try again. }
9596       if TryFirstLocalIdentOccurrence(CursorNode,OrigCleanCursorPos,CleanCursorPos) then
9597         exit(true);
9598     except
9599       on E: ECodeToolError do
9600       begin
9601         // we have a codetool error, let's try to find the assignment in any case
9602         LastCodeToolsErrorCleanPos := CurPos.StartPos;
9603         LastCodeToolsError := ECodeToolError.Create(E.Sender,E.Id,E.Message);
9604       end else
9605         raise;
9606     end;
9607 
9608     // find first assignment before current.
9609     if TryAssignment(CursorNode, OrigCleanCursorPos, CleanCursorPos) then
9610       Exit(true);
9611 
9612     if LastCodeToolsError<>nil then // no assignment found, reraise
9613       ClearAndRaise(LastCodeToolsError, LastCodeToolsErrorCleanPos);
9614   finally
9615     LastCodeToolsError.Free;
9616   end;
9617 
9618   if CompleteMethodByBody(OrigCleanCursorPos,OldTopLine,CursorNode,
9619                          NewPos,NewTopLine,SourceChangeCache)
9620   then
9621     exit(true);
9622 
9623   {$IFDEF CTDEBUG}
9624   DebugLn('TCodeCompletionCodeTool.CompleteCode  nothing to complete ... ');
9625   {$ENDIF}
9626 end;
9627 
CreateVariableForIdentifiernull9628 function TCodeCompletionCodeTool.CreateVariableForIdentifier(
9629   CursorPos: TCodeXYPosition; OldTopLine: integer; out NewPos: TCodeXYPosition;
9630   out NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
9631   ): boolean;
9632 var
9633   CleanCursorPos: integer;
9634   CursorNode: TCodeTreeNode;
9635 begin
9636   Result:=false;
9637   NewPos:=CleanCodeXYPosition;
9638   NewTopLine:=0;
9639   if (SourceChangeCache=nil) then
9640     RaiseException(20170421201910,'need a SourceChangeCache');
9641   BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
9642 
9643   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
9644   CodeCompleteSrcChgCache:=SourceChangeCache;
9645 
9646   {$IFDEF CTDEBUG}
9647   DebugLn('TCodeCompletionCodeTool.CreateVariableForIdentifier A CleanCursorPos=',dbgs(CleanCursorPos),' NodeDesc=',NodeDescriptionAsString(CursorNode.Desc));
9648   {$ENDIF}
9649 
9650   // test if Local variable assignment (i:=3)
9651   Result:=CompleteVariableAssignment(CleanCursorPos,OldTopLine,
9652     CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9653   if Result then exit;
9654 
9655   // test if undeclared local variable as parameter (GetPenPos(x,y))
9656   Result:=CompleteIdentifierByParameter(CleanCursorPos,OldTopLine,
9657     CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9658   if Result then exit;
9659 
9660   MoveCursorToCleanPos(CleanCursorPos);
9661   RaiseException(20170421201915,'this syntax is not supported by variable completion');
9662 end;
9663 
AddMethodsnull9664 function TCodeCompletionCodeTool.AddMethods(CursorPos: TCodeXYPosition;
9665   OldTopLine: integer; ListOfPCodeXYPosition: TFPList;
9666   const VirtualToOverride: boolean; out NewPos: TCodeXYPosition; out
9667   NewTopLine, BlockTopLine, BlockBottomLine: integer;
9668   SourceChangeCache: TSourceChangeCache): boolean;
9669 var
9670   CleanCursorPos: integer;
9671   CursorNode: TCodeTreeNode;
9672   i: Integer;
9673   CodeXYPos: TCodeXYPosition;
9674   ProcNode: TCodeTreeNode;
9675   NewMethods: TAVLTree;// Tree of TCodeTreeNodeExtension
9676   NewCodeTool: TFindDeclarationTool;
9677   CleanProcCode: String;
9678   FullProcCode: String;
9679   VirtualStartPos: LongInt;
9680   VirtualEndPos: integer;
9681   VisibilityDesc: TCodeTreeNodeDesc;
9682   NodeExt: TCodeTreeNodeExtension;
9683   AVLNode: TAVLTreeNode;
9684   ProcName: String;
9685   NewClassPart: TNewClassPart;
9686   Beauty: TBeautifyCodeOptions;
9687   ProcCode: String;
9688   CurClassName: String;
9689 begin
9690   Result:=false;
9691   if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then
9692     exit(true);
9693 
9694   if (SourceChangeCache=nil) then
9695     RaiseException(20170421201918,'need a SourceChangeCache');
9696 
9697   CodeCompleteSrcChgCache:=SourceChangeCache;
9698   Beauty:=SourceChangeCache.BeautifyCodeOptions;
9699   NewMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
9700   try
9701     ActivateGlobalWriteLock;
9702     try
9703       // collect all methods
9704       for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
9705         //get next code position
9706         CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
9707         // get codetool for this position
9708         NewCodeTool:=OnGetCodeToolForBuffer(Self,CodeXYPos.Code,true);
9709         if NewCodeTool=nil then begin
9710           DebugLn(['TCodeCompletionCodeTool.AddMethods unit not found for source ',CodeXYPos.Code.Filename,'(',CodeXYPos.Y,',',CodeXYPos.X,')']);
9711           exit;
9712         end;
9713         // parse unit
9714         NewCodeTool.BuildTreeAndGetCleanPos(CodeXYPos,CleanCursorPos);
9715         // find node at position
9716         ProcNode:=NewCodeTool.BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
9717         if (ProcNode.Desc<>ctnProcedure)
9718         or (ProcNode.Parent=nil) then begin
9719           NewCodeTool.MoveCursorToNodeStart(ProcNode);
9720           RaiseException(20170421201921,'TCodeCompletionCodeTool.AddMethods source position not a procedure');
9721         end;
9722         // find visibility
9723         VisibilityDesc:=ctnClassPublic;
9724         if ProcNode.Parent.Desc in AllClassBaseSections then
9725           VisibilityDesc:=ProcNode.Parent.Desc;
9726         // extract proc
9727         ProcName:=NewCodeTool.ExtractProcName(ProcNode,[phpWithoutClassName,phpInUpperCase]);
9728         CleanProcCode:=NewCodeTool.ExtractProcHead(ProcNode,[phpWithoutClassName]);
9729         FullProcCode:=NewCodeTool.ExtractProcHead(ProcNode,
9730                     [phpWithStart,phpWithoutClassName,phpWithVarModifiers,
9731                      phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
9732                      phpWithCallingSpecs,phpWithProcModifiers]);
9733         if VirtualToOverride then begin
9734           VirtualStartPos:=SearchProcSpecifier(FullProcCode,'virtual',
9735                           VirtualEndPos,NewCodeTool.Scanner.NestedComments);
9736           debugln(['TCodeCompletionCodeTool.AddMethods FullProcCode="',FullProcCode,'" VirtualStartPos=',VirtualStartPos]);
9737           if VirtualStartPos>=1 then begin
9738             // replace virtual with override
9739             FullProcCode:=copy(FullProcCode,1,VirtualStartPos-1)
9740                          +'override;'
9741                          +copy(FullProcCode,VirtualEndPos,length(FullProcCode));
9742           end;
9743           // remove abstract
9744           FullProcCode:=RemoveProcSpecifier(FullProcCode,'abstract',
9745                                             NewCodeTool.Scanner.NestedComments);
9746         end;
9747 
9748         ProcCode:=NewCodeTool.ExtractProcHead(ProcNode,[phpWithStart,
9749                   phpWithoutClassName,phpWithVarModifiers,phpWithParameterNames,
9750                   phpWithResultType,phpWithCallingSpecs]);
9751         ProcCode:=ProcCode+Beauty.LineEnd
9752                     +'begin'+Beauty.LineEnd
9753                     +Beauty.GetIndentStr(Beauty.Indent)+Beauty.LineEnd
9754                     +'end;';
9755 
9756         // add method data
9757         NodeExt:=TCodeTreeNodeExtension.Create;
9758         NodeExt.Txt:=CleanProcCode;
9759         NodeExt.ExtTxt1:=FullProcCode;
9760         NodeExt.ExtTxt2:=ProcName;
9761         NodeExt.ExtTxt3:=ProcCode;
9762         NodeExt.Flags:=VisibilityDesc;
9763         NewMethods.Add(NodeExt);
9764         //DebugLn(['TCodeCompletionCodeTool.AddMethods ',i,' CleanProcTxt=',CleanProcCode,' FullProcTxt=',FullProcCode]);
9765       end;
9766 
9767     finally
9768       DeactivateGlobalWriteLock;
9769     end;
9770 
9771     BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
9772 
9773     // find node at position
9774     CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
9775 
9776     // if cursor is on type node, find class node
9777     if CursorNode.Desc=ctnTypeDefinition then
9778       CursorNode:=CursorNode.FirstChild
9779     else if CursorNode.Desc=ctnGenericType then
9780       CursorNode:=CursorNode.LastChild
9781     else
9782       CursorNode:=FindClassOrInterfaceNode(CursorNode);
9783     if (CursorNode=nil) or (not (CursorNode.Desc in AllClasses)) then begin
9784       DebugLn(['TIdentCompletionTool.AddMethods cursor not in a class']);
9785       exit;
9786     end;
9787     //DebugLn(['TCodeCompletionCodeTool.AddMethods CursorNode=',CursorNode.DescAsString]);
9788 
9789     CodeCompleteSrcChgCache:=SourceChangeCache;
9790     CodeCompleteClassNode:=CursorNode;
9791     CurClassName:=ExtractClassName(CursorNode,false);
9792 
9793     // add methods
9794     AVLNode:=NewMethods.FindLowest;
9795     while AVLNode<>nil do begin
9796       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
9797       CleanProcCode:=NodeExt.Txt;
9798       FullProcCode:=NodeExt.ExtTxt1;
9799       ProcName:=NodeExt.ExtTxt2;
9800       ProcCode:=NodeExt.ExtTxt3;
9801       VisibilityDesc:=TCodeTreeNodeDesc(NodeExt.Flags);
9802       case VisibilityDesc of
9803       ctnClassPrivate:   NewClassPart:=ncpPrivateProcs;
9804       ctnClassProtected: NewClassPart:=ncpProtectedProcs;
9805       ctnClassPublic:    NewClassPart:=ncpPublicProcs;
9806       ctnClassPublished: NewClassPart:=ncpPublishedProcs;
9807       else               NewClassPart:=ncpPublicProcs;
9808       end;
9809 
9810       // change classname
9811       ProcCode:=Beauty.AddClassAndNameToProc(ProcCode,CurClassName,ProcName);
9812       AddClassInsertion(CleanProcCode,FullProcCode,ProcName,NewClassPart,nil,
9813                         ProcCode);
9814 
9815       AVLNode:=NewMethods.FindSuccessor(AVLNode);
9816     end;
9817 
9818     // apply changes
9819     if not ApplyChangesAndJumpToFirstNewProc(CleanCursorPos,OldTopLine,true,
9820       NewPos,NewTopLine, BlockTopLine, BlockBottomLine) then exit;
9821 
9822     Result:=true;
9823   finally
9824     FreeClassInsertionList;
9825     DisposeAVLTree(NewMethods);
9826   end;
9827 end;
9828 
9829 constructor TCodeCompletionCodeTool.Create;
9830 begin
9831   inherited Create;
9832   FSetPropertyVariablename:='AValue';
9833   FSetPropertyVariableIsPrefix := false;
9834   FSetPropertyVariableUseConst := false;
9835   FCompleteProperties:=true;
9836   FAddInheritedCodeToOverrideMethod:=true;
9837 end;
9838 
9839 end.
9840 
9841