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) then // the "source" types are different -> add unit to the type
1946           NewType := ExprType.Context.Tool.ExtractSourceName + '.' + NewType
1947         else
1948         begin // the "source" types are the same -> set ExprType to found Params.New* so that unit adding is avoided (with MissingUnit)
1949           ExprType.Context.Tool:=Params.NewCodeTool;
1950           ExprType.Context.Node:=Params.NewNode;
1951         end;
1952       end;
1953     end;
1954   finally
1955     Params.Free;
1956     DeactivateGlobalWriteLock;
1957   end;
1958 
1959   MissingUnit:='';
1960   if (ExprType.Desc=xtContext)
1961   and (ExprType.Context.Tool<>nil) then
1962     MissingUnit:=GetUnitNameForUsesSection(ExprType.Context.Tool);
1963 
1964   NewName := GetAtom(VarNameAtom);
1965   FindProcAndClassNode(CursorNode, ProcNode, ClassNode);
1966   if Interactive and (ClassNode<>nil) then
1967   begin
1968     Result:=True;
1969     if not ShowCodeCreationDlg(NewName+': '+NewType+';', False, CCOptions) then
1970       Exit;
1971   end else
1972     CCOptions.Location := cclLocal;
1973 
1974   if CCOptions.Location=cclLocal then
1975     Result:=AddLocalVariable(CleanCursorPos,OldTopLine,NewName,
1976                         NewType,MissingUnit,NewPos,NewTopLine,SourceChangeCache)
1977   else
1978   begin
1979     // initialize class for code completion
1980     CodeCompleteClassNode:=ClassNode;
1981     CodeCompleteSrcChgCache:=SourceChangeCache;
1982     AddClassInsertion(UpperCase(NewName)+';', NewName+':'+NewType+';',
1983       NewName, InsertClassSectionToNewVarClassPart[CCOptions.ClassSection]);
1984     if not InsertAllNewClassParts then
1985       RaiseException(20170421201536,ctsErrorDuringInsertingNewClassParts);
1986     // apply the changes
1987     if not SourceChangeCache.Apply then
1988       RaiseException(20170421201538,ctsUnableToApplyChanges);
1989   end;
1990 end;
1991 
TCodeCompletionCodeTool.CompleteEventAssignmentnull1992 function TCodeCompletionCodeTool.CompleteEventAssignment(CleanCursorPos,
1993   OldTopLine: integer; CursorNode: TCodeTreeNode; out
1994   IsEventAssignment: boolean; var NewPos: TCodeXYPosition;
1995   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache;
1996   Interactive: Boolean): boolean;
1997 { examples:
1998     Button1.OnClick:=|
1999     OnClick:=@AnEve|nt
2000     with Button1 do OnMouseDown:=@|
2001 
2002   If OnClick is a method then it will be completed to
2003     Button1.OnClick:=@Button1Click;
2004   and a 'procedure Button1Click(Sender: TObject);' with a method body will
2005   be added to the published section of the class of the Begin..End Block.
2006 }
2007 
CheckEventAssignmentSyntaxnull2008   function CheckEventAssignmentSyntax(out PropVarAtom: TAtomPosition;
2009     out AssignmentOperator, AddrOperatorPos: integer;
2010     out UserEventAtom: TAtomPosition;
2011     out SemicolonPos: integer): boolean;
2012   begin
2013     Result:=false;
2014 
2015     // check if in begin..end block
2016     if not ((CursorNode.Desc=ctnBeginBlock)
2017             or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
2018     // read event name (optional)
2019 
2020     while (CleanCursorPos<SrcLen)
2021     and (Src[CleanCursorPos] in [':','=',' ',#9]) do
2022       inc(CleanCursorPos);
2023     GetIdentStartEndAtPosition(Src,CleanCursorPos,
2024                                UserEventAtom.StartPos,UserEventAtom.EndPos);
2025     MoveCursorToAtomPos(UserEventAtom);
2026     if AtomIsKeyWord then exit;
2027     ReadPriorAtom;
2028     // check @ operator (optional)
2029     if AtomIsChar('@') then begin
2030       AddrOperatorPos:=CurPos.StartPos;
2031       ReadPriorAtom;
2032     end else
2033       AddrOperatorPos:=-1;
2034     // check assignment operator :=
2035     if not AtomIs(':=') then exit;
2036     ReadPriorAtom;
2037     AssignmentOperator:=CurPos.EndPos;
2038     // check event name
2039     if not AtomIsIdentifier then exit;
2040     PropVarAtom:=CurPos;
2041 
2042     // check for semicolon at end of statement
2043     MoveCursorToCleanPos(UserEventAtom.EndPos);
2044     ReadNextAtom;
2045     if CurPos.Flag = cafRoundBracketOpen then
2046       if Scanner.CompilerMode <> cmDELPHI then
e.g.null2047         Exit // indeed it is assignment to function, e.g. x:=sin(y);
2048       else begin
2049         ReadNextAtom;
2050         if CurPos.Flag <> cafRoundBracketClose then
2051           Exit; // in Delhi mode empty brackets are allowed after method: OnClick:=FormCreate();
2052         ReadNextAtom;
2053       end;
2054     if AtomIsChar(';') then
2055       SemicolonPos:=CurPos.StartPos
2056     else
2057       SemicolonPos:=-1;
2058 
2059     {$IFDEF CTDEBUG}
2060     DebugLn('  CheckEventAssignmentSyntax: "',copy(Src,PropertyAtom.StartPos,
2061           UserEventAtom.EndPos-PropertyAtom.StartPos),'"');
2062     {$ENDIF}
2063 
2064     Result:=true;
2065   end;
2066 
FindEventTypeAtCursornull2067   function FindEventTypeAtCursor(PropVarAtom: TAtomPosition;
2068     out PropVarContext, ProcContext: TFindContext;
2069     Params: TFindDeclarationParams): boolean;
2070   begin
2071     Result:=false;
2072     // find declaration of property identifier
2073     Params.ContextNode:=CursorNode;
2074     MoveCursorToCleanPos(PropVarAtom.StartPos);
2075     Params.SetIdentifier(Self,@Src[CurPos.StartPos],nil);
2076     fFullTopLvlName:='';
2077     Params.OnTopLvlIdentifierFound:=@OnTopLvlIdentifierFound;
2078     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
2079                    fdfTopLvlResolving,fdfFindVariable];
2080     if (not FindDeclarationOfIdentAtParam(Params)) then begin
2081       {$IFDEF CTDEBUG}
2082       DebugLn('FindEventTypeAtCursor identifier "',GetIdentifier(@Src[CurPos.StartPos]),'" not found');
2083       {$ENDIF}
2084       exit;
2085     end;
2086     if not (Params.NewNode.Desc in [ctnProperty,ctnVarDefinition]) then begin
2087       {$IFDEF CTDEBUG}
2088       DebugLn('FindEventTypeAtCursor not a property/variable');
2089       {$ENDIF}
2090       exit;
2091     end;
2092     PropVarContext:=CreateFindContext(Params);
2093     // identifier is property
2094     // -> check type of property
2095     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers];
2096     ProcContext:=PropVarContext.Tool.FindBaseTypeOfNode(
2097                                                     Params,PropVarContext.Node);
2098     if (ProcContext.Node=nil)
2099     or not (ProcContext.Node.Desc in AllProcTypes)
2100     then begin
2101       {$IFDEF CTDEBUG}
2102       DebugLn('FindEventTypeAtCursor not a procedure type');
2103       {$ENDIF}
2104       exit;
2105     end;
2106     // identifier is property/var of type proc => this is an event
2107     Result:=true;
2108   end;
2109 
CreateEventFullNamenull2110   function CreateEventFullName(AClassNode: TCodeTreeNode; UserEventAtom,
2111     PropVarAtom: TAtomPosition): string;
2112   var PropVarName, AClassName: string;
2113     l: integer;
2114   begin
2115     if UserEventAtom.StartPos=UserEventAtom.EndPos then begin
2116       Result:=fFullTopLvlName;
2117       l:=PropVarAtom.EndPos-PropVarAtom.StartPos;
2118       PropVarName:=copy(Src,PropVarAtom.StartPos,l);
2119       if SysUtils.CompareText(PropVarName,RightStr(Result,l))<>0 then
2120         Result:=Result+PropVarName;
2121       if SysUtils.CompareText(PropVarName,Result)=0 then begin
2122         // this is an event of the class (not event of published objects)
2123         // -> add form name
2124         MoveCursorToNodeStart(AClassNode.Parent);
2125         ReadNextAtom;
2126         AClassName:=GetAtom;
2127         if (length(AClassName)>1) and (AClassName[1] in ['t','T']) then
2128           System.Delete(AClassName,1,1);
2129         Result:=AClassName+Result;
2130       end;
2131       // convert OnClick to Click
2132       if (UpperCaseStr(LeftStr(PropVarName,2))='ON')
2133       and (SysUtils.CompareText(RightStr(Result,l),PropVarName)=0)
2134       then
2135         Result:=LeftStr(Result,length(Result)-l)+RightStr(Result,l-2);
2136     end else begin
2137       Result:=copy(Src,UserEventAtom.StartPos,
2138                           UserEventAtom.EndPos-UserEventAtom.StartPos);
2139     end;
2140     {$IFDEF CTDEBUG}
2141     DebugLn('CreateEventFullName "',Result,'"');
2142     {$ENDIF}
2143   end;
2144 
CompleteAssignmentnull2145   function CompleteAssignment(const AnEventName: string;
2146     AssignmentOperator, AddrOperatorPos, SemicolonPos: integer;
2147     UserEventAtom: TAtomPosition): boolean;
2148   var RValue: string;
2149     StartInsertPos, EndInsertPos: integer;
2150   begin
2151     {$IFDEF CTDEBUG}
2152     DebugLn('  CompleteEventAssignment: Changing right side of assignment...');
2153     {$ENDIF}
2154     // add new event name as right value of assignment
2155     // add address operator @ if needed or user provided it himself
2156     RValue:=AnEventName+';';
2157     if (AddrOperatorPos>0)
2158     or ((Scanner.PascalCompiler=pcFPC) and (Scanner.CompilerMode<>cmDelphi))
2159     then
2160       RValue:='@'+RValue;
2161     RValue:=':='+RValue;
2162     RValue:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(RValue,0);
2163     StartInsertPos:=AssignmentOperator;
2164     EndInsertPos:=SemicolonPos+1;
2165     if EndInsertPos<1 then
2166       EndInsertPos:=UserEventAtom.EndPos;
2167     if EndInsertPos<1 then
2168       EndInsertPos:=AddrOperatorPos;
2169     if EndInsertPos<1 then
2170       EndInsertPos:=AssignmentOperator+2;
2171     Result:=SourceChangeCache.Replace(gtNone,gtNewLine,
2172                                       StartInsertPos,EndInsertPos,RValue);
2173   end;
2174 
2175   procedure AddProcedure(Identifier: string;
2176     TypeTool: TFindDeclarationTool; TypeNode: TCodeTreeNode);
2177   var
2178     ProcContext: TFindContext;
2179     AMethodDefinition: string;
2180     AMethodAttr: TProcHeadAttributes;
2181   begin
2182     // create new method
2183     ProcContext:=CreateFindContext(TypeTool,TypeNode);
2184     AddProcedureCompatibleToProcType(Identifier,
2185       ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,
2186       CursorNode);
2187 
2188     // apply the changes
2189     if not SourceChangeCache.Apply then
2190       RaiseException(20170421201540,ctsUnableToApplyChanges);
2191 
2192     {$IFDEF CTDEBUG}
2193     DebugLn('  CompleteEventAssignment.AddProcedure: jumping to new method body...');
2194     {$ENDIF}
2195     // jump to new method body
2196     if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2197     then
2198       RaiseException(20170421201543,'CompleteEventAssignment.AddProcedure JumpToMethod failed');
2199   end;
2200 
CompleteEventAssignmentnull2201 // function CompleteEventAssignment: boolean
2202 var
2203   UserEventAtom, PropVarAtom: TAtomPosition;
2204   AssignmentOperator, AddrOperatorPos, SemicolonPos: integer;
2205   Params: TFindDeclarationParams;
2206   PropertyContext, ProcContext: TFindContext;
2207   FullEventName, AMethodDefinition: string;
2208   AMethodAttr: TProcHeadAttributes;
2209   ProcNode, AClassNode: TCodeTreeNode;
2210   Identifier: String;
2211 begin
2212   IsEventAssignment:=false;
2213   Result:=false;
2214 
2215   {$IFDEF VerboseCompleteEventAssign}
2216   DebugLn('  CompleteEventAssignment: CheckEventAssignmentSyntax...');
2217   {$ENDIF}
2218   // check assigment syntax
2219   if not CheckEventAssignmentSyntax(PropVarAtom, AssignmentOperator,
2220                                    AddrOperatorPos, UserEventAtom, SemicolonPos)
2221   then
2222     exit;
2223   IsEventAssignment:=true;
2224   if OldTopLine=0 then ;
2225 
2226   ProcNode:=nil;
2227   AClassNode:=nil;
2228   CheckWholeUnitParsed(CursorNode,ProcNode);
2229 
2230   if CursorNode.Desc=ctnBeginBlock then
2231     BuildSubTreeForBeginBlock(CursorNode);
2232   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
2233 
2234   {$IFDEF VerboseCompleteEventAssign}
2235   DebugLn('  CompleteEventAssignment: check if a method and find class...');
2236   {$ENDIF}
2237   FindProcAndClassNode(CursorNode,ProcNode,AClassNode);
2238 
2239   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2240   try
2241     {$IFDEF VerboseCompleteEventAssign}
2242     DebugLn('  CompleteEventAssignment: FindEventTypeAtCursor...');
2243     {$ENDIF}
2244     // check if identifier is event property and build
2245     Result:=FindEventTypeAtCursor(PropVarAtom,PropertyContext,ProcContext,
2246                                   Params);
2247     if not Result then exit;
2248 
2249     if ((AClassNode<>nil) and (ProcContext.Node.Desc=ctnReferenceTo))
2250     or ProcContext.Tool.ProcNodeHasOfObject(ProcContext.Node) then begin
2251       if AClassNode<>nil then begin
2252         {$IFDEF VerboseCompleteEventAssign}
2253         DebugLn('  CompleteEventAssignment: CreateEventFullName... UserEventAtom.StartPos=',dbgs(UserEventAtom.StartPos));
2254         {$ENDIF}
2255         // create a nice event name
2256         FullEventName:=CreateEventFullName(AClassNode,UserEventAtom,PropVarAtom);
2257         if FullEventName='' then exit;
2258 
2259         // add published method and method body and right side of assignment
2260         if not AddMethodCompatibleToProcType(AClassNode,FullEventName,ProcContext,
2261           AMethodDefinition,AMethodAttr,SourceChangeCache,Interactive)
2262         then
2263           Exit;
2264         if not CompleteAssignment(FullEventName,AssignmentOperator,
2265           AddrOperatorPos,SemicolonPos,UserEventAtom)
2266         then
2267           RaiseException(20170421201546,'CompleteEventAssignment CompleteAssignment failed');
2268       end else if ProcContext.Tool.ProcNodeHasOfObject(ProcContext.Node) then begin
2269         {$IFDEF VerboseCompleteEventAssign}
2270         debugln(['  CompleteEventAssignment:  proc is "of object"']);
2271         {$ENDIF}
2272         MoveCursorToCleanPos(PropVarAtom.StartPos);
2273         RaiseException(20170421201550,'Complete event failed: procedure of object needs a class');
2274       end;
2275     end else begin
2276       // create procedure (not method)
2277       {$IFDEF VerboseCompleteEventAssign}
2278       debugln(['  CompleteEventAssignment: create a proc name']);
2279       {$ENDIF}
2280       // get name
2281       Identifier:='';
2282       if (UserEventAtom.StartPos>1) and (UserEventAtom.StartPos<=SrcLen) then
2283         Identifier:=GetIdentifier(@Src[UserEventAtom.StartPos]);
2284       if Identifier='' then
2285         Identifier:=GetIdentifier(@Src[PropVarAtom.StartPos]);
2286       if Identifier='' then begin
2287         MoveCursorToCleanPos(PropVarAtom.StartPos);
2288         RaiseException(20170421201553,'Complete event failed: need a name');
2289       end;
2290       // create proc
2291       {$IFDEF VerboseCompleteEventAssign}
2292       debugln(['  CompleteEventAssignment: create a proc name']);
2293       {$ENDIF}
2294       AddProcedureCompatibleToProcType(Identifier,
2295         ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,
2296         CursorNode);
2297     end;
2298   finally
2299     Params.Free;
2300   end;
2301 
2302   {$IFDEF VerboseCompleteEventAssign}
2303   DebugLn('  CompleteEventAssignment: Applying changes...');
2304   {$ENDIF}
2305   // apply the changes
2306   if not SourceChangeCache.Apply then
2307     RaiseException(20170421201555,ctsUnableToApplyChanges);
2308 
2309   {$IFDEF VerboseCompleteEventAssign}
2310   DebugLn('  CompleteEventAssignment: jumping to new method body...');
2311   {$ENDIF}
2312   // jump to new method body
2313   if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2314   then
2315     RaiseException(20170421201558,'CompleteEventAssignment Internal Error 2');
2316 
2317   Result:=true;
2318 end;
2319 
CompleteVariableForInnull2320 function TCodeCompletionCodeTool.CompleteVariableForIn(CleanCursorPos,
2321   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
2322   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
2323   ): boolean;
2324 var
2325   VarNameAtom: TAtomPosition;
2326   TermAtom: TAtomPosition;
2327   Params: TFindDeclarationParams;
2328   NewType: String;
2329   ExprType: TExpressionType;
2330   MissingUnit: String;
2331 begin
2332   Result:=false;
2333 
2334   {$IFDEF CTDEBUG}
2335   DebugLn('  CompleteLocalVariableForIn: A');
2336   {$ENDIF}
2337   if not ((CursorNode.Desc=ctnBeginBlock)
2338           or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
2339   if CursorNode.Desc=ctnBeginBlock then
2340     BuildSubTreeForBeginBlock(CursorNode);
2341   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
2342 
2343   {$IFDEF CTDEBUG}
2344   DebugLn('  CompleteLocalVariableForIn: B CheckLocalVarForInSyntax ...');
2345   {$ENDIF}
2346   // check assignment syntax
2347   if not CheckLocalVarForInSyntax(CleanCursorPos,
2348     VarNameAtom,TermAtom)
2349   then
2350     exit;
2351   DebugLn(['TCodeCompletionCodeTool.CompleteLocalVariableForIn Var=',GetAtom(VarNameAtom),' Term=',GetAtom(TermAtom)]);
2352 
2353   // search variable
2354   ActivateGlobalWriteLock;
2355   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2356   try
2357     {$IFDEF CTDEBUG}
2358     DebugLn('  CompleteLocalVariableForIn: check if variable is already defined ...');
2359     {$ENDIF}
2360     // check if identifier exists
2361     Result:=IdentifierIsDefined(VarNameAtom,CursorNode,Params);
2362     if Result then begin
2363       MoveCursorToCleanPos(VarNameAtom.StartPos);
2364       ReadNextAtom;
2365       RaiseExceptionFmt(20170421201601,ctsIdentifierAlreadyDefined,[GetAtom]);
2366     end;
2367 
2368     {$IFDEF CTDEBUG}
2369     DebugLn('  CompleteLocalVariableForIn: Find type of term ...',
2370     ' Term="',copy(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"');
2371     {$ENDIF}
2372     // find type of term
2373     NewType:=FindForInTypeAsString(TermAtom,CursorNode,Params,ExprType);
2374     if NewType='' then
2375       RaiseException(20170421201604,'CompleteLocalVariableForIn Internal error: NewType=""');
2376 
2377   finally
2378     Params.Free;
2379     DeactivateGlobalWriteLock;
2380   end;
2381 
2382   MissingUnit:='';
2383   if (ExprType.Desc=xtContext)
2384   and (ExprType.Context.Tool<>nil) then
2385     MissingUnit:=GetUnitNameForUsesSection(ExprType.Context.Tool);
2386 
2387   Result:=AddLocalVariable(CleanCursorPos,OldTopLine,GetAtom(VarNameAtom),
2388                       NewType,MissingUnit,NewPos,NewTopLine,SourceChangeCache);
2389 end;
2390 
CompleteIdentifierByParameternull2391 function TCodeCompletionCodeTool.CompleteIdentifierByParameter(CleanCursorPos,
2392   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
2393   var NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
2394   ): boolean;
2395 
2396   procedure AddMethod(Identifier: string;
2397     TypeTool: TFindDeclarationTool; TypeNode: TCodeTreeNode);
2398   var
2399     AMethodAttr: TProcHeadAttributes;
2400     AMethodDefinition: string;
2401     ProcContext: TFindContext;
2402     AClassNode: TCodeTreeNode;
2403   begin
2404     // parameter needs a method => search class of method
2405     AClassNode:=FindClassOrInterfaceNode(CursorNode,true);
2406     if (AClassNode=nil) then
2407       RaiseException(20170421201607,'parameter needs a method');
2408     ProcContext:=CreateFindContext(TypeTool,TypeNode);
2409 
2410     // create new method
2411     if not AddMethodCompatibleToProcType(AClassNode,Identifier,
2412       ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,Interactive)
2413     then
2414       Exit;
2415 
2416     // apply the changes
2417     if not SourceChangeCache.Apply then
2418       RaiseException(20170421201609,ctsUnableToApplyChanges);
2419 
2420     {$IFDEF CTDEBUG}
2421     DebugLn('  CompleteIdentifierByParameter.AddMethod: jumping to new method body...');
2422     {$ENDIF}
2423     // jump to new method body
2424     if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2425     then
2426       RaiseException(20170421201612,'CompleteIdentifierByParameter.AddMethod JumpToMethod failed');
2427   end;
2428 
2429   procedure AddProcedure(Identifier: string;
2430     TypeTool: TFindDeclarationTool; TypeNode: TCodeTreeNode);
2431   var
2432     ProcContext: TFindContext;
2433     AMethodDefinition: string;
2434     AMethodAttr: TProcHeadAttributes;
2435   begin
2436     // create new method
2437     ProcContext:=CreateFindContext(TypeTool,TypeNode);
2438     AddProcedureCompatibleToProcType(Identifier,
2439       ProcContext,AMethodDefinition,AMethodAttr,SourceChangeCache,
2440       CursorNode);
2441 
2442     // apply the changes
2443     if not SourceChangeCache.Apply then
2444       RaiseException(20170421201614,ctsUnableToApplyChanges);
2445 
2446     {$IFDEF CTDEBUG}
2447     DebugLn('  CompleteIdentifierByParameter.AddProcedure: jumping to new method body...');
2448     {$ENDIF}
2449     // jump to new method body
2450     if not JumpToMethod(AMethodDefinition,AMethodAttr,NewPos,NewTopLine)
2451     then
2452       RaiseException(20170421201617,'CompleteIdentifierByParameter.AddProcedure JumpToMethod failed');
2453   end;
2454 
2455 var
2456   VarNameRange, ProcNameAtom: TAtomPosition;
2457   ParameterIndex: integer;
2458   Params: TFindDeclarationParams;
2459   ParameterNode: TCodeTreeNode;
2460   TypeNode: TCodeTreeNode;
2461   NewType: String;
2462   IgnorePos: TCodePosition;
2463   MissingUnitName: String;
2464   ProcStartPos: LongInt;
2465   ExprType: TExpressionType;
2466   Context: TFindContext;
2467   HasAtOperator: Boolean;
2468   TypeTool: TFindDeclarationTool;
2469   AliasType: TFindContext;
2470   Identifier: String;
2471 begin
2472   Result:=false;
2473 
2474   {$IFDEF CTDEBUG}
2475   DebugLn('  CompleteIdentifierByParameter: A');
2476   {$ENDIF}
2477   if not ((CursorNode.Desc=ctnBeginBlock)
2478           or CursorNode.HasParentOfType(ctnBeginBlock)) then exit;
2479   if CursorNode.Desc=ctnBeginBlock then
2480     BuildSubTreeForBeginBlock(CursorNode);
2481   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
2482 
2483   {$IFDEF CTDEBUG}
2484   DebugLn('  CompleteIdentifierByParameter: B check if it is a parameter ...');
2485   {$ENDIF}
2486   // check parameter syntax
2487   if not CheckParameterSyntax(CursorNode.StartPos,CleanCursorPos,
2488                               VarNameRange,ProcNameAtom,ParameterIndex)
2489   then
2490     exit;
2491   HasAtOperator:=false;
2492   if (VarNameRange.StartPos<=SrcLen)
2493   and (Src[VarNameRange.StartPos]='@') then begin
2494     HasAtOperator:=true;
2495     MoveCursorToCleanPos(VarNameRange.StartPos+1);
2496     ReadNextAtom;
2497     VarNameRange.StartPos:=CurPos.StartPos;
2498     //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter HasAtOperator ',GetAtom(VarNameRange)]);
2499   end;
2500   Identifier:=ExtractCode(VarNameRange.StartPos,VarNameRange.EndPos,[]);
2501   if not IsValidIdent(Identifier) then exit;
2502 
2503   {$IFDEF CTDEBUG}
2504   DebugLn('  CompleteIdentifierByParameter VarNameAtom=',GetAtom(VarNameAtom),' ProcNameAtom=',GetAtom(ProcNameAtom),' ParameterIndex=',dbgs(ParameterIndex));
2505   {$ENDIF}
2506 
2507   // search variable
2508   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2509   try
2510     {$IFDEF CTDEBUG}
2511     DebugLn('  CompleteIdentifierByParameter: check if variable is already defined ...');
2512     {$ENDIF}
2513     // check if identifier exists
2514     Result:=IdentifierIsDefined(VarNameRange,CursorNode,Params);
2515     if Result then begin
2516       MoveCursorToCleanPos(VarNameRange.StartPos);
2517       ReadNextAtom;
2518       RaiseExceptionFmt(20170421201619,ctsIdentifierAlreadyDefined,[GetAtom]);
2519     end;
2520 
2521     {$IFDEF CTDEBUG}
2522     DebugLn('  CompleteIdentifierByParameter: Find declaration of parameter list ...  procname="',GetAtom(ProcNameAtom),'"');
2523     {$ENDIF}
2524 
2525     Context:=CreateFindContext(Self,CursorNode);
2526     ProcStartPos:=FindStartOfTerm(ProcNameAtom.EndPos,false);
2527     if ProcStartPos<ProcNameAtom.StartPos then begin
2528       // for example: Canvas.Line
2529       // find class
2530       {$IFDEF CTDEBUG}
2531       debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter Call="',ExtractCode(ProcStartPos,ProcNameAtom.EndPos,[]),'"']);
2532       {$ENDIF}
2533       Params.ContextNode:=Context.Node;
2534       Params.Flags:=fdfDefaultForExpressions+[fdfFunctionResult,fdfFindChildren];
2535       ExprType:=FindExpressionResultType(Params,ProcStartPos,ProcNameAtom.StartPos);
2536       if not(ExprType.Desc in xtAllIdentTypes) then begin
2537         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter Call="',ExtractCode(ProcStartPos,ProcNameAtom.StartPos,[]),'" gives ',ExprTypeToString(ExprType)]);
2538         exit;
2539       end;
2540       Context:=ExprType.Context;
2541       if Assigned(Context.Tool) and Assigned(Context.Node) then
2542       begin
2543         // resolve point '.'
2544         //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter base class: ',FindContextToString(Context)]);
2545         Params.Clear;
2546         Params.Flags:=fdfDefaultForExpressions;
2547         Context:=Context.Tool.FindBaseTypeOfNode(Params,Context.Node);
2548         {$IFDEF CTDEBUG}
2549         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter search proc in sub context: ',FindContextToString(Context)]);
2550         {$ENDIF}
2551       end;
2552     end;
2553     if Assigned(Context.Tool) and Assigned(Context.Node) then
2554     begin
2555       // find declaration of parameter list
2556       // ToDo: search in all overloads for the best fit
2557       Params.ContextNode:=Context.Node;
2558       Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],nil);
2559       Params.Flags:=fdfDefaultForExpressions+[fdfFindVariable];
2560       if Context.Node=CursorNode then
2561         Params.Flags:=Params.Flags+[fdfSearchInParentNodes,fdfIgnoreCurContextNode]
2562       else
2563         Params.Flags:=Params.Flags-[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
2564       CleanPosToCodePos(VarNameRange.StartPos,IgnorePos);
2565       IgnoreErrorAfter:=IgnorePos;
2566       try
2567         {$IFDEF CTDEBUG}
2568         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter searching ',GetIdentifier(Params.Identifier),' [',dbgs(Params.Flags),'] in ',FindContextToString(Context)]);
2569         {$ENDIF}
2570         if not Context.Tool.FindIdentifierInContext(Params) then exit;
2571       finally
2572         ClearIgnoreErrorAfter;
2573       end;
2574     end else
2575     if (ExprType.Desc in xtAllTypeHelperTypes) then
2576     begin
2577       Params.ContextNode:=CursorNode;
2578       Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],nil);
2579       Params.Flags:=fdfDefaultForExpressions+[fdfFindVariable]+
2580         [fdfSearchInParentNodes,fdfIgnoreCurContextNode];
2581       FindIdentifierInBasicTypeHelpers(ExprType.Desc, Params);
2582     end;
2583 
2584     NewType:='';
2585     MissingUnitName:='';
2586     if Params.NewNode=nil then exit;
2587     //DebugLn('TCodeCompletionCodeTool.CompleteLocalVariableAsParameter Proc/PropNode=',Params.NewNode.DescAsString,' ',copy(Params.NewCodeTool.Src,Params.NewNode.StartPos,50));
2588 
2589     if Params.NewNode.Desc=ctnVarDefinition then
2590     begin
2591       try
2592         ExprType:=Params.NewCodeTool.ConvertNodeToExpressionType(Params.NewNode,Params);
2593         if (ExprType.Desc=xtContext) and (ExprType.Context.Node<>nil) then begin
2594           Params.NewCodeTool:=ExprType.Context.Tool;
2595           Params.NewNode:=ExprType.Context.Node;
2596         end;
2597       except
2598       end;
2599     end;
2600     ParameterNode:=Params.NewCodeTool.FindNthParameterNode(Params.NewNode,
2601                                                            ParameterIndex);
2602     if (ParameterNode=nil)
2603     and (Params.NewNode.Desc in [ctnProperty,ctnProcedure]) then begin
2604       DebugLn(['  CompleteIdentifierByParameter Procedure has less than ',ParameterIndex+1,' parameters']);
2605       exit;
2606     end;
2607     if ParameterNode=nil then exit;
2608     //DebugLn('TCodeCompletionCodeTool.CompleteIdentifierByParameter ParameterNode=',ParameterNode.DescAsString,' ',copy(Params.NewCodeTool.Src,ParameterNode.StartPos,50));
2609     TypeTool:=Params.NewCodeTool;
2610     TypeNode:=FindTypeNodeOfDefinition(ParameterNode);
2611     if TypeNode=nil then begin
2612       DebugLn('  CompleteIdentifierByParameter Parameter has no type');
2613       exit;
2614     end;
2615     // default: copy the type
2616     NewType:=TypeTool.ExtractCode(TypeNode.StartPos,TypeNode.EndPos,[]);
2617 
2618     // search type
2619     Params.Clear;
2620     Params.ContextNode:=TypeNode;
2621     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
2622                    fdfTopLvlResolving];
2623     AliasType:=CleanFindContext;
2624     ExprType:=TypeTool.FindExpressionResultType(Params,
2625                               TypeNode.StartPos,TypeNode.EndPos,@AliasType);
2626     //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter type: AliasType=',FindContextToString(AliasType)]);
2627 
2628     TypeTool:=ExprType.Context.Tool;
2629     TypeNode:=ExprType.Context.Node;
2630     if HasAtOperator
2631     or ((Scanner.CompilerMode=cmDelphi) and (ExprType.Desc=xtContext) // procedures in delphi mode without @
2632         and (TypeNode<>nil) and (TypeNode.Desc in AllProcTypes)) then
2633     begin
2634       debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter HasAtOperator ExprType=',ExprTypeToString(ExprType)]);
2635       NewType:='';
2636       if (ExprType.Desc<>xtContext)
2637       or (TypeNode=nil) then begin
2638         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter has @ operator, but this is not implemented for ',ExprTypeToString(ExprType)]);
2639         exit;
2640       end;
2641       if (TypeNode.Desc=ctnPointerType) then begin
2642         // for example PMapID = ^...
2643         if (TypeNode.FirstChild<>nil)
2644         and (TypeNode.FirstChild.Desc=ctnIdentifier) then begin
2645           // for example PMapID = ^TMapID
2646           NewType:=TypeTool.ExtractCode(TypeNode.FirstChild.StartPos,
2647                                         TypeNode.FirstChild.EndPos,[]);
2648           //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter pointer to ',NewType]);
2649           Params.Clear;
2650           Params.ContextNode:=TypeNode;
2651           Params.Flags:=fdfDefaultForExpressions;
2652           AliasType:=CleanFindContext;
2653           ExprType:=TypeTool.FindExpressionResultType(Params,
2654             TypeNode.FirstChild.StartPos,TypeNode.FirstChild.EndPos,
2655             @AliasType);
2656           //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter is pointer to type: AliasType=',FindContextToString(AliasType)]);
2657         end;
2658       end else if TypeNode.Desc in AllProcTypes then begin
2659         // for example TNotifyEvent = procedure(...
2660         if TypeTool.ProcNodeHasOfObject(TypeNode) then begin
2661           AddMethod(Identifier,TypeTool,TypeNode);
2662         end else begin
2663           // parameter needs a procedure
2664           AddProcedure(Identifier,TypeTool,TypeNode);
2665         end;
2666         exit(true);
2667       end;
2668       if NewType='' then begin
2669         debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter parameter has @ operator, but this is not implemented for ',ExprTypeToString(ExprType)]);
2670         exit;
2671       end;
2672     end;
2673     if AliasType.Node<>nil then begin
2674       // an identifier
2675       MissingUnitName:=GetUnitNameForUsesSection(AliasType.Tool);
2676       //debugln(['TCodeCompletionCodeTool.CompleteIdentifierByParameter MissingUnitName=',MissingUnitName]);
2677     end;
2678 
2679     //DebugLn('TCodeCompletionCodeTool.CompleteIdentifierByParameter NewType=',NewType);
2680     if NewType='' then
2681       RaiseException(20170421201622,'CompleteIdentifierByParameter Internal error: NewType=""');
2682     //DebugLn('  CompleteIdentifierByParameter Dont know: ',Params.NewNode.DescAsString);
2683 
2684   finally
2685     Params.Free;
2686   end;
2687 
2688   Result:=AddLocalVariable(CleanCursorPos,OldTopLine,GetAtom(VarNameRange),
2689                    NewType,MissingUnitName,NewPos,NewTopLine,SourceChangeCache);
2690 end;
2691 
TCodeCompletionCodeTool.CompleteMethodByBodynull2692 function TCodeCompletionCodeTool.CompleteMethodByBody(
2693   CleanCursorPos, OldTopLine: integer;
2694   CursorNode: TCodeTreeNode;
2695   var NewPos: TCodeXYPosition; var NewTopLine: integer;
2696   SourceChangeCache: TSourceChangeCache): boolean;
2697 const
2698   ProcAttrCopyBodyToDef = [phpWithStart,phpWithoutClassName,phpWithVarModifiers,
2699     phpWithParameterNames,phpWithDefaultValues,phpWithResultType];
2700 
2701   procedure MergeProcModifiers(DefProcNode, BodyProcNode: TCodeTreeNode;
2702     var ProcCode: String);
2703   var
2704     FirstBodyModAtom: TAtomPosition;
2705     BodyHeadEnd: Integer;
2706     DefHeadEnd: Integer;
2707     Modifier: shortstring;
2708     OldCursor: TAtomPosition;
2709     AddModifier: boolean;
2710   begin
2711     MoveCursorToFirstProcSpecifier(DefProcNode);
2712     if DefProcNode.FirstChild<>nil then
2713       DefHeadEnd:=DefProcNode.FirstChild.EndPos
2714     else
2715       DefHeadEnd:=DefProcNode.EndPos;
2716     FirstBodyModAtom:=CleanAtomPosition;
2717     BodyHeadEnd:=0;
2718     while CurPos.EndPos<DefHeadEnd do begin
2719       if CurPos.Flag<>cafSemicolon then begin
2720         // a modifier of the definition
2721         Modifier:=copy(GetAtom,1,255);
2722         //debugln(['MergeProcModifiers body modifier: ',Modifier]);
2723         if not IsKeyWordCallingConvention.DoItCaseInsensitive(Modifier) then
2724         begin
2725           // test if body already has this modifier
2726           OldCursor:=CurPos;
2727           if BodyHeadEnd=0 then begin
2728             MoveCursorToFirstProcSpecifier(BodyProcNode);
2729             FirstBodyModAtom:=CurPos;
2730             if BodyProcNode.FirstChild<>nil then
2731               BodyHeadEnd:=BodyProcNode.FirstChild.EndPos
2732             else
2733               BodyHeadEnd:=BodyProcNode.EndPos;
2734           end else
2735             MoveCursorToAtomPos(FirstBodyModAtom);
2736           while CurPos.EndPos<BodyHeadEnd do begin
2737             if CurPos.Flag<>cafSemicolon then begin
2738               if AtomIs(Modifier) then break;
2739               // skip to next modifier of body
2740               repeat
2741                 ReadNextAtom;
2742               until (CurPos.Flag=cafSemicolon) or (CurPos.EndPos>=BodyHeadEnd);
2743             end else
2744               ReadNextAtom;
2745           end;
2746           AddModifier:=CurPos.EndPos>=BodyHeadEnd;
2747           MoveCursorToAtomPos(OldCursor);
2748         end else
2749           AddModifier:=false;
2750         // skip to next modifier of definition
2751         repeat
2752           if AddModifier then begin
2753             if (IsIdentStartChar[Src[CurPos.StartPos]]
2754             and IsIdentChar[ProcCode[length(ProcCode)]]) // space needed between words
2755             or IsSpaceChar[Src[CurPos.StartPos-1]] // copy space from body
2756             then
2757               ProcCode:=ProcCode+' ';
2758             ProcCode:=ProcCode+GetAtom;
2759           end;
2760           ReadNextAtom;
2761         until (CurPos.Flag=cafSemicolon) or (CurPos.EndPos>=DefHeadEnd);
2762         if AddModifier then
2763           ProcCode:=ProcCode+';';
2764       end else
2765         ReadNextAtom;
2766     end;
2767   end;
2768 
2769 var
2770   CurClassName: String;
2771   BodyProcNode: TCodeTreeNode;
2772   CleanProcCode: String;
2773   ProcName: String;
2774   OldCodePos: TCodePosition;
2775   ClassProcs: TAVLTree;
2776   ProcBodyNodes: TAVLTree;
2777   AVLNode: TAVLTreeNode;
2778   NodeExt: TCodeTreeNodeExtension;
2779   DefProcNode: TCodeTreeNode;
2780   NewProcCode: String;
2781   OldProcCode: String;
2782   FromPos: Integer;
2783   EndPos: Integer;
2784   Indent: Integer;
2785   Beauty: TBeautifyCodeOptions;
2786 begin
2787   Result:=false;
2788 
2789   // check if cursor in a method
2790   if CursorNode.Desc=ctnProcedure then
2791     BodyProcNode:=CursorNode
2792   else
2793     BodyProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
2794   if (BodyProcNode=nil) or (BodyProcNode.Desc<>ctnProcedure)
2795   or (not NodeIsMethodBody(BodyProcNode)) then begin
2796     {$IFDEF VerboseCompleteMethod}
2797     DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody node is not a method body ',BodyProcNode<>nil]);
2798     {$ENDIF}
2799     exit;
2800   end;
2801 
2802   CheckWholeUnitParsed(CursorNode,BodyProcNode);
2803 
2804   // find corresponding class declaration
2805   CurClassName:=ExtractClassNameOfProcNode(BodyProcNode);
2806   if CurClassName='' then begin
2807     DebugLn(['CompleteMethodByBody ExtractClassNameOfProcNode failed']);
2808     exit;
2809   end;
2810   //DebugLn(['CompleteMethod CurClassName=',CurClassName]);
2811   CodeCompleteClassNode:=FindClassNodeInUnit(CurClassName,true,false,false,true);
2812 
2813   Beauty:=SourceChangeCache.BeautifyCodeOptions;
2814   ClassProcs:=nil;
2815   ProcBodyNodes:=nil;
2816   try
2817     // find the corresponding node in the class
2818     DefProcNode:=nil;
2819 
2820     // gather existing proc definitions in the class
2821     ClassProcs:=GatherClassProcDefinitions(CodeCompleteClassNode,true);
2822     CleanProcCode:=ExtractProcHead(BodyProcNode,[phpInUpperCase]);
2823     NodeExt:=FindCodeTreeNodeExt(ClassProcs,CleanProcCode);
2824     if NodeExt<>nil then begin
2825       DefProcNode:=TCodeTreeNodeExtension(NodeExt).Node;
2826     end else begin
2827       // the proc was not found by name+params
2828       // => guess
2829       ProcBodyNodes:=GatherClassProcBodies(CodeCompleteClassNode);
2830       GuessProcDefBodyMapping(ClassProcs,ProcBodyNodes,true,true);
2831       AVLNode:=ProcBodyNodes.FindLowest;
2832       NodeExt:=nil;
2833       while AVLNode<>nil do begin
2834         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
2835         if NodeExt.Node=BodyProcNode then begin
2836           if NodeExt.Data<>nil then
2837             DefProcNode:=TCodeTreeNodeExtension(NodeExt.Data).Node;
2838           break;
2839         end;
2840         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
2841       end;
2842     end;
2843 
2844     if DefProcNode<>nil then begin
2845       // update existing definition
2846       {$IFDEF VerboseCompleteMethod}
2847       DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody corresponding definition exists for "',CleanProcCode,'"']);
2848       {$ENDIF}
2849       OldProcCode:=ExtractProcHead(DefProcNode,ProcAttrCopyBodyToDef+[phpWithProcModifiers]);
2850       NewProcCode:=ExtractProcHead(BodyProcNode,ProcAttrCopyBodyToDef+[phpWithCallingSpecs]);
2851       // some modifiers are only allowed in the definition
2852       // => keep the old definition modifiers
2853       MergeProcModifiers(DefProcNode,BodyProcNode,NewProcCode);
2854       if CompareTextIgnoringSpace(NewProcCode,OldProcCode,false)=0 then
2855         exit(true); // already matching
2856       // ToDo: definition needs update
2857       {$IFDEF VerboseCompleteMethod}
2858       debugln(['TCodeCompletionCodeTool.CompleteMethodByBody OldProcCode="',OldProcCode,'"']);
2859       debugln(['TCodeCompletionCodeTool.CompleteMethodByBody NewProcCode="',NewProcCode,'"']);
2860       {$ENDIF}
2861       // store old cursor position
2862       if not CleanPosToCodePos(CleanCursorPos,OldCodePos) then begin
2863         RaiseException(20170421201627,'TCodeCompletionCodeTool.CompleteMethodByBody Internal Error: '
2864           +'CleanPosToCodePos');
2865       end;
2866 
2867       Indent:=Beauty.GetLineIndent(Src,DefProcNode.StartPos);
2868       FromPos:=DefProcNode.StartPos;
2869       EndPos:=DefProcNode.EndPos;
2870       SourceChangeCache.MainScanner:=Scanner;
2871       NewProcCode:=Beauty.BeautifyStatement(
2872                                   NewProcCode,Indent,[bcfDoNotIndentFirstLine]);
2873       {$IFDEF VerboseCompleteMethod}
2874       debugln('TCodeCompletionCodeTool.CompleteMethodByBody final NewProcCode:');
2875       debugln(NewProcCode);
2876       {$ENDIF}
2877       if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,EndPos,NewProcCode)
2878       then
2879         exit;
2880       Result:=SourceChangeCache.Apply;
2881     end else begin
2882       // insert new definition
2883       ProcName:=ExtractProcName(BodyProcNode,[phpWithoutClassName]);
2884       {$IFDEF VerboseCompleteMethod}
2885       DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody Adding body to definition "',CleanProcCode,'"']);
2886       {$ENDIF}
2887 
2888       // store old cursor position
2889       if not CleanPosToCodePos(CleanCursorPos,OldCodePos) then begin
2890         RaiseException(20170421201630,'TCodeCompletionCodeTool.CompleteMethodByBody Internal Error: '
2891           +'CleanPosToCodePos');
2892       end;
2893 
2894       CodeCompleteSrcChgCache:=SourceChangeCache;
2895 
2896       // add method declaration
2897       NewProcCode:=ExtractProcHead(BodyProcNode,ProcAttrCopyBodyToDef+[phpWithCallingSpecs]);
2898       CleanProcCode:=ExtractProcHead(BodyProcNode,
2899                        [phpWithoutClassKeyword,phpWithoutClassName,phpInUpperCase]);
2900       AddClassInsertion(CleanProcCode,NewProcCode,ProcName,ncpPrivateProcs);
2901 
2902       // apply changes
2903       Result:=ApplyClassCompletion(false);
2904     end;
2905     // adjust cursor position
2906     AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
2907   finally
2908     DisposeAVLTree(ClassProcs);
2909     DisposeAVLTree(ProcBodyNodes);
2910   end;
2911 
2912   {$IFDEF VerboseCompleteMethod}
2913   DebugLn(['TCodeCompletionCodeTool.CompleteMethodByBody END OldCodePos.P=',OldCodePos.P,' OldTopLine=',OldTopLine,' NewPos=',Dbgs(NewPos),' NewTopLine=',NewTopLine]);
2914   {$ENDIF}
2915 end;
2916 
CreateParamListFromStatementnull2917 function TCodeCompletionCodeTool.CreateParamListFromStatement(
2918   CursorNode: TCodeTreeNode; BracketOpenPos: integer; out CleanList: string
2919   ): string;
2920 var
2921   ParamNames: TStringToStringTree;
2922 
CreateParamNamenull2923   function CreateParamName(ExprStartPos, ExprEndPos: integer;
2924     const ParamType: string): string;
2925   var
2926     i: Integer;
2927   begin
2928     Result:='';
2929     // use the last identifier of expression as name
2930     MoveCursorToCleanPos(ExprStartPos);
2931     repeat
2932       ReadNextAtom;
2933       if AtomIsIdentifier then
2934         Result:=GetAtom
2935       else
2936         Result:='';
2937     until CurPos.EndPos>=ExprEndPos;
2938     // otherwise use ParamType
2939     if Result='' then
2940       Result:=ParamType;
2941     // otherwise use 'Param'
2942     if not IsValidIdent(Result) then
2943       Result:='Param';
2944     // prepend an 'a'
2945     if Result[1]<>'a' then
2946       Result:='a'+Result;
2947     // make unique
2948     if ParamNames=nil then
2949       ParamNames:=TStringToStringTree.Create(false);
2950     if ParamNames.Contains(Result) then begin
2951       i:=1;
2952       while ParamNames.Contains(Result+IntToStr(i)) do inc(i);
2953       Result:=Result+IntToStr(i);
2954     end;
2955     ParamNames[Result]:='used';
2956   end;
2957 
2958 var
2959   i: Integer;
2960   ExprList: TExprTypeList;
2961   ParamExprType: TExpressionType;
2962   ParamType: String;
2963   ExprStartPos: LongInt;
2964   ExprEndPos: LongInt;
2965   Params: TFindDeclarationParams;
2966   ParamName: String;
2967   // create param list without brackets
2968   {$IFDEF EnableCodeCompleteTemplates}
2969   Colon : String;
2970   {$ENDIF}
2971 begin
2972   Result:='';
2973   CleanList:='';
2974   ExprList:=nil;
2975   ParamNames:=nil;
2976   ActivateGlobalWriteLock;
2977   Params:=TFindDeclarationParams.Create(Self, CursorNode);
2978   try
2979     // check parameter list
2980     ExprList:=CreateParamExprListFromStatement(BracketOpenPos,Params);
2981 
2982     // create parameter list
2983     MoveCursorToCleanPos(BracketOpenPos);
2984     ReadNextAtom;
2985     //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement BracketClose=',BracketClose]);
2986     for i:=0 to ExprList.Count-1 do begin
2987       ReadNextAtom;
2988       ExprStartPos:=CurPos.StartPos;
2989       // read til comma or bracket close
2990       repeat
2991         //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement loop ',GetAtom]);
2992         if (CurPos.StartPos>SrcLen)
2993         or (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose,cafComma])
2994         then
2995           break;
2996         if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
2997           ReadTilBracketClose(true);
2998         end;
2999         ReadNextAtom;
3000       until false;
3001       ExprEndPos:=CurPos.StartPos;
3002       //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement Param=',copy(Src,ExprStartPos,ExprEndPos-ExprStartPos)]);
3003       // get type
3004       ParamExprType:=ExprList.Items[i];
3005       ParamType:=FindExprTypeAsString(ParamExprType,ExprStartPos);
3006       // create a nice parameter name
3007       ParamName:=CreateParamName(ExprStartPos,ExprEndPos,ParamType);
3008       //DebugLn(['TCodeCompletionCodeTool.CreateParamListFromStatement ',i,' ',ParamName,':',ParamType]);
3009       if Result<>'' then begin
3010         Result:=Result+';';
3011         CleanList:=CleanList+';';
3012       end;
3013       {$IFDEF EnableCodeCompleteTemplates}
3014       if assigned(CTTemplateExpander)
3015       and CTTemplateExpander.TemplateExists('PrettyColon') then
3016       begin
3017         Colon := CTTemplateExpander.Expand('PrettyColon', '','', // Doesn't use linebreak or indentation
3018                                  [], [] );
3019         Result:=Result+ParamName+Colon+ParamType;
3020         CleanList:=CleanList+Colon+ParamType;
3021       end
3022       else
3023       {$ENDIF EnableCodeCompleteTemplates}
3024       begin
3025         Result:=Result+ParamName+':'+ParamType;
3026         CleanList:=CleanList+':'+ParamType;
3027       end;
3028       // next
3029       MoveCursorToCleanPos(ExprEndPos);
3030       ReadNextAtom;
3031     end;
3032   finally
3033     ExprList.Free;
3034     Params.Free;
3035     ParamNames.Free;
3036     DeactivateGlobalWriteLock;
3037   end;
3038 end;
3039 
CompleteProcByCallnull3040 function TCodeCompletionCodeTool.CompleteProcByCall(CleanCursorPos,
3041   OldTopLine: integer; CursorNode: TCodeTreeNode; var NewPos: TCodeXYPosition;
3042   var NewTopLine, BlockTopLine, BlockBottomLine: integer;
3043   SourceChangeCache: TSourceChangeCache): boolean;
3044 // check if 'procname(expr list);'
3045 const
3046   ShortProcFormat = [phpWithoutClassKeyword];
3047 
3048   function CheckProcSyntax(out BeginNode: TCodeTreeNode;
3049     out ProcNameAtom: TAtomPosition;
3050     out BracketOpenPos, BracketClosePos: LongInt): boolean;
3051   begin
3052     Result:=false;
3053     // check if in a begin..end block
3054     if CursorNode=nil then exit;
3055     BeginNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
3056     if BeginNode=nil then exit;
3057     // check if CleanCursorPos is valid
3058     if (CleanCursorPos>SrcLen) then CleanCursorPos:=SrcLen;
3059     if (CleanCursorPos<1) then exit;
3060     // skip bracket
3061     if (Src[CleanCursorPos]='(') then dec(CleanCursorPos);
3062     // go to start of identifier
3063     while (CleanCursorPos>1) and (IsIdentChar[Src[CleanCursorPos-1]]) do
3064       dec(CleanCursorPos);
3065     // read procname
3066     MoveCursorToCleanPos(CleanCursorPos);
3067     ReadNextAtom;
3068     if not AtomIsIdentifier then exit;
3069     ProcNameAtom:=CurPos;
3070     // read bracket
3071     ReadNextAtom;
3072     if CurPos.Flag<>cafRoundBracketOpen then exit;
3073     BracketOpenPos:=CurPos.StartPos;
3074     // read bracket close
3075     if not ReadTilBracketClose(false) then exit;
3076     BracketClosePos:=CurPos.StartPos;
3077     Result:=true;
3078   end;
3079 
3080   function CheckFunctionType(const ProcNameAtom: TAtomPosition;
3081     out IsFunction: Boolean;
3082     out FuncType: String;
3083     out ProcExprStartPos: integer): boolean;
3084   begin
3085     Result:=false;
3086     // find start of proc expression (e.g. Button1.Constrains.DoSomething)
3087     IsFunction:=false;
3088     FuncType:='';
3089     ProcExprStartPos:=FindStartOfTerm(ProcNameAtom.EndPos,false);
3090     if ProcExprStartPos<0 then exit;
3091     MoveCursorToCleanPos(ProcExprStartPos);
3092     ReadPriorAtom;
3093     if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen])
3094     or (UpAtomIs(':=')) then begin
3095       FuncType:='integer';
3096       IsFunction:=true;
3097     end;
3098     Result:=true;
3099   end;
3100 
3101   function CheckProcDoesNotExist(Params: TFindDeclarationParams;
3102     const ProcNameAtom: TAtomPosition): boolean;
3103   begin
3104     Result:=false;
3105     // check if proc already exists
3106     Params.ContextNode:=CursorNode;
3107     Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CheckSrcIdentifier);
3108     Params.Flags:=[fdfSearchInParentNodes,
3109                    fdfTopLvlResolving,fdfSearchInAncestors,fdfSearchInHelpers,
3110                    fdfIgnoreCurContextNode];
3111     if FindIdentifierInContext(Params) then begin
3112       // proc already exists
3113       DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall proc already exists']);
3114       MoveCursorToCleanPos(ProcNameAtom.StartPos);
3115       ReadNextAtom;
3116       RaiseExceptionFmt(20170421201633,ctsIdentifierAlreadyDefined,[GetAtom]);
3117     end;
3118     Result:=true;
3119   end;
3120 
3121   function CreateProcCode(CursorNode: TCodeTreeNode;
3122     const ProcNameAtom: TAtomPosition;
3123     IsFunction: boolean; const FuncType: string;
3124     BracketOpenPos, Indent: integer;
3125     out CleanProcHead, ProcCode: string): boolean;
3126   var
3127     le: String;
3128     ProcName: String;
3129     Beauty: TBeautifyCodeOptions;
3130   begin
3131     Result:=false;
3132 
3133     Beauty:=SourceChangeCache.BeautifyCodeOptions;
3134 
3135     // create param list
3136     ProcCode:=CreateParamListFromStatement(CursorNode,BracketOpenPos,CleanProcHead);
3137     if ProcCode<>'' then begin
3138       ProcCode:='('+ProcCode+')';
3139       CleanProcHead:='('+CleanProcHead+')';
3140     end;
3141 
3142     // prepend proc name
3143     ProcName:=GetAtom(ProcNameAtom);
3144     ProcCode:=ProcName+ProcCode;
3145     CleanProcHead:=ProcName+CleanProcHead;
3146 
3147     // prepend 'procedure' keyword
3148     if IsFunction then
3149     begin
3150       {$IFDEF EnableCodeCompleteTemplates}
3151       if (CTTemplateExpander<>nil)
3152       and CTTemplateExpander.TemplateExists('PrettyColon') then
3153       begin
3154         ProcCode:= 'function '+ProcCode+
3155                    CTTemplateExpander.Expand('PrettyColon','','',[],[])
3156                    +FuncType+';';
3157       end
3158       else
3159       {$ENDIF}
3160       begin
3161         ProcCode:='function '+ProcCode+':'+FuncType+';';
3162       end;
3163     end
3164     else
3165       ProcCode:='procedure '+ProcCode+';';
3166     CleanProcHead:=CleanProcHead+';';
3167 
3168     // append begin..end
3169     le:=Beauty.LineEnd;
3170     ProcCode:=ProcCode+le
3171       +'begin'+le
3172       +le
3173       +'end;';
3174 
3175     ProcCode:=Beauty.BeautifyStatement(ProcCode,Indent);
3176 
3177     DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall ',ProcCode]);
3178     Result:=true;
3179   end;
3180 
3181   function CreatePathForNewProc(InsertPos: integer;
3182     const CleanProcHead: string;
3183     out NewProcPath: TStrings): boolean;
3184   var
3185     ContextNode: TCodeTreeNode;
3186   begin
3187     Result:=false;
3188     // find context at insert position
3189     ContextNode:=FindDeepestNodeAtPos(InsertPos,true);
3190     if (ContextNode.Desc=ctnProcedure) and (ContextNode.StartPos=InsertPos)
3191     or ((ContextNode.LastChild<>nil) and (ContextNode.LastChild.StartPos<InsertPos))
3192     then
3193       // ContextNode is a procedure below or above the insert position
3194       // => after the insert the new proc will not be a child
3195       // -> it will become a child of its parent
3196       ContextNode:=ContextNode.Parent;
3197     NewProcPath:=CreateSubProcPath(ContextNode,ShortProcFormat);
3198     // add new proc
3199     NewProcPath.Add(CleanProcHead);
3200 
3201     DebugLn(['CreatePathForNewProc NewProcPath=',NewProcPath.Text]);
3202     Result:=true;
3203   end;
3204 
3205   function FindJumpPointToNewProc(SubProcPath: TStrings): boolean;
3206   var
3207     NewProcNode: TCodeTreeNode;
3208   begin
3209     Result:=false;
3210     // reparse code and find jump point into new proc
3211     BuildTree(lsrInitializationStart);
3212     NewProcNode:=FindSubProcPath(SubProcPath,ShortProcFormat,true);
3213     if NewProcNode=nil then begin
3214       debugln(['FindJumpPointToNewProc FindSubProcPath failed, SubProcPath="',SubProcPath.Text,'"']);
3215       exit;
3216     end;
3217     Result:=FindJumpPointInProcNode(NewProcNode,NewPos,NewTopLine,BlockTopLine,BlockBottomLine);
3218     { $IFDEF CTDebug}
3219     if Result then
3220       DebugLn('TCodeCompletionCodeTool.CompleteProcByCall END ',NewProcNode.DescAsString,' ',dbgs(Result),' ',dbgs(NewPos.X),',',dbgs(NewPos.Y),' ',dbgs(NewTopLine));
3221     { $ENDIF}
3222   end;
3223 
3224 var
3225   BeginNode: TCodeTreeNode;
3226   ProcNameAtom: TAtomPosition;
3227   BracketOpenPos, BracketClosePos: integer;
3228   ExprType: TExpressionType;
3229   Params: TFindDeclarationParams;
3230   InsertPos: LongInt;
3231   Indent: LongInt;
3232   ExprList: TExprTypeList;
3233   ProcNode: TCodeTreeNode;
3234   ProcCode: String;
3235   ProcExprStartPos: LongInt;
3236   IsFunction: Boolean;
3237   FuncType: String;
3238   CleanProcHead: string;
3239   NewProcPath: TStrings;
3240   Beauty: TBeautifyCodeOptions;
3241 begin
3242   Result:=false;
3243   if not CheckProcSyntax(BeginNode,ProcNameAtom,BracketOpenPos,BracketClosePos)
3244   then exit;
3245   if OldTopLine=0 then ;
3246 
3247   CheckWholeUnitParsed(CursorNode,BeginNode);
3248 
3249   Beauty:=SourceChangeCache.BeautifyCodeOptions;
3250   Params:=TFindDeclarationParams.Create(Self, CursorNode);
3251   ExprList:=nil;
3252   ActivateGlobalWriteLock;
3253   try
3254     if not CheckFunctionType(ProcNameAtom,IsFunction,FuncType,ProcExprStartPos)
3255     then exit;
3256     DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall Call="',copy(Src,ProcNameAtom.StartPos,BracketClosePos+1-ProcNameAtom.StartPos),'"']);
3257     if not CheckProcDoesNotExist(Params,ProcNameAtom) then exit;
3258 
3259     // find context (e.g. Button1.|)
3260     Params.Clear;
3261     Params.ContextNode:=CursorNode;
3262     ExprType:=FindExpressionTypeOfTerm(-1,ProcNameAtom.StartPos,Params,false);
3263     DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall Context: ',ExprTypeToString(ExprType)]);
3264 
3265     if ExprType.Desc=xtNone then begin
3266       // default context
3267       if NodeIsInAMethod(CursorNode) then begin
3268         // eventually: create a new method
3269         DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall ToDo: create a new method']);
3270         exit;
3271       end else begin
3272         ProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
3273         if ProcNode<>nil then begin
3274           // this is a normal proc or nested proc
3275           // insert new proc in front
3276           InsertPos:=FindLineEndOrCodeInFrontOfPosition(ProcNode.StartPos);
3277           Indent:=Beauty.GetLineIndent(Src,ProcNode.StartPos);
3278           debugln(['TCodeCompletionCodeTool.CompleteProcByCall insert as new proc in front of proc']);
3279         end else begin
3280           // this is a begin..end without proc (e.g. program or unit code)
3281           // insert new proc in front
3282           InsertPos:=FindLineEndOrCodeInFrontOfPosition(BeginNode.StartPos);
3283           Indent:=Beauty.GetLineIndent(Src,BeginNode.StartPos);
3284           debugln(['TCodeCompletionCodeTool.CompleteProcByCall insert as new proc in front of begin']);
3285         end;
3286       end;
3287     end else begin
3288       // eventually: create a new method in another class
3289       DebugLn(['TCodeCompletionCodeTool.CompleteProcByCall ToDo: create a new method in another class']);
3290       exit;
3291     end;
3292 
3293     if not CreateProcCode(CursorNode,ProcNameAtom,
3294       IsFunction,FuncType,BracketOpenPos,Indent,
3295       CleanProcHead,ProcCode)
3296     then begin
3297       debugln(['TCodeCompletionCodeTool.CompleteProcByCall CreateProcCode failed']);
3298       exit;
3299     end;
3300 
3301   finally
3302     DeactivateGlobalWriteLock;
3303     Params.Free;
3304     ExprList.Free;
3305   end;
3306 
3307   // insert proc body
3308   //debugln(['TCodeCompletionCodeTool.CompleteProcByCall InsertPos=',CleanPosToStr(InsertPos),' ProcCode="',ProcCode,'"']);
3309   if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
3310     InsertPos,InsertPos,ProcCode)
3311   then
3312     exit;
3313 
3314   // remember old path
3315   NewProcPath:=nil;
3316   try
3317     if not CreatePathForNewProc(InsertPos,CleanProcHead,NewProcPath) then begin
3318       debugln(['TCodeCompletionCodeTool.CompleteProcByCall CreatePathForNewProc failed']);
3319       exit;
3320     end;
3321     if not SourceChangeCache.Apply then begin
3322       debugln(['TCodeCompletionCodeTool.CompleteProcByCall SourceChangeCache.Apply failed']);
3323       exit;
3324     end;
3325     //debugln(['TCodeCompletionCodeTool.CompleteProcByCall ',TCodeBuffer(Scanner.MainCode).Source]);
3326     if not FindJumpPointToNewProc(NewProcPath) then begin
3327       debugln(['TCodeCompletionCodeTool.CompleteProcByCall FindJumpPointToNewProc(',NewProcPath.Text,') failed']);
3328       exit;
3329     end;
3330     Result:=true;
3331   finally
3332     NewProcPath.Free;
3333   end;
3334 end;
3335 
3336 procedure TCodeCompletionCodeTool.DoDeleteNodes(StartNode: TCodeTreeNode);
3337 begin
3338   inherited DoDeleteNodes(StartNode);
3339   FCompletingCursorNode:=nil;
3340   FreeClassInsertionList;
3341 end;
3342 
AddPublishedVariablenull3343 function TCodeCompletionCodeTool.AddPublishedVariable(const UpperClassName,
3344   VarName, VarType: string; SourceChangeCache: TSourceChangeCache): boolean;
3345 begin
3346   Result:=false;
3347   if (UpperClassName='') or (VarName='') or (VarType='')
3348   or (SourceChangeCache=nil) or (Scanner=nil) then exit;
3349   // find classnode
3350   BuildTree(lsrImplementationStart);
3351   // initialize class for code completion
3352   CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
3353   CodeCompleteSrcChgCache:=SourceChangeCache;
3354   // check if variable already exists
3355   if not VarExistsInCodeCompleteClass(UpperCaseStr(VarName)) then begin
3356   {$IFDEF EnableCodeCompleteTemplates}
3357     if (CTTemplateExpander<>nil)
3358     and CTTemplateExpander.TemplateExists('PrettyColon') then
3359     begin
3360       AddClassInsertion(UpperCaseStr(VarName),
3361         VarName+CTTemplateExpander.Expand('PrettyColon','','',[],[])
3362                +VarType+';',VarName,ncpPublishedVars);
3363 
3364     end
3365   else
3366   {$ENDIF}
3367     AddClassInsertion(UpperCaseStr(VarName),
3368                       VarName+':'+VarType+';',VarName,ncpPublishedVars);
3369     if not InsertAllNewClassParts then
3370       RaiseException(20170421201635,ctsErrorDuringInsertingNewClassParts);
3371     // apply the changes
3372     if not SourceChangeCache.Apply then
3373       RaiseException(20170421201637,ctsUnableToApplyChanges);
3374   end;
3375   Result:=true;
3376 end;
3377 
GetRedefinitionNodeTextnull3378 function TCodeCompletionCodeTool.GetRedefinitionNodeText(Node: TCodeTreeNode
3379   ): string;
3380 begin
3381   case Node.Desc of
3382   ctnProcedure:
3383     Result:=ExtractProcHead(Node,[phpInUpperCase,phpWithoutSemicolon]);
3384   ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnEnumIdentifier,
3385   ctnGenericType:
3386     Result:=ExtractDefinitionName(Node);
3387   else
3388     Result:='';
3389   end;
3390 end;
3391 
FindRedefinitionsnull3392 function TCodeCompletionCodeTool.FindRedefinitions(
3393   out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
3394 var
3395   AllNodes: TAVLTree;
3396 
3397   procedure AddRedefinition(Redefinition, Definition: TCodeTreeNode;
3398     const NodeText: string);
3399   var
3400     NodeExt: TCodeTreeNodeExtension;
3401   begin
3402     DebugLn(['AddRedefinition ',NodeText,' Redefined=',CleanPosToStr(Redefinition.StartPos),' Definition=',CleanPosToStr(Definition.StartPos)]);
3403     //DebugLn(['AddRedefinition as source: Definition="',ExtractNode(Definition,[]),'" Redefinition="',ExtractNode(Redefinition,[]),'"']);
3404     NodeExt:=TCodeTreeNodeExtension.Create;
3405     NodeExt.Node:=Redefinition;
3406     NodeExt.Data:=Definition;
3407     NodeExt.Txt:=NodeText;
3408     if TreeOfCodeTreeNodeExt=nil then
3409       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3410     TreeOfCodeTreeNodeExt.Add(NodeExt);
3411   end;
3412 
3413   procedure AddDefinition(Node: TCodeTreeNode; const NodeText: string);
3414   var
3415     NodeExt: TCodeTreeNodeExtension;
3416   begin
3417     NodeExt:=TCodeTreeNodeExtension.Create;
3418     NodeExt.Node:=Node;
3419     NodeExt.Txt:=NodeText;
3420     AllNodes.Add(NodeExt);
3421   end;
3422 
3423 var
3424   Node: TCodeTreeNode;
3425   NodeText: String;
3426   AVLNode: TAVLTreeNode;
3427 begin
3428   Result:=false;
3429   TreeOfCodeTreeNodeExt:=nil;
3430   BuildTree(lsrImplementationStart);
3431 
3432   AllNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3433   try
3434     Node:=Tree.Root;
3435     while Node<>nil do begin
3436       case Node.Desc of
3437       ctnImplementation, ctnInitialization, ctnFinalization,
3438       ctnBeginBlock, ctnAsmBlock:
3439         // skip implementation
3440         break;
3441       ctnVarDefinition, ctnTypeDefinition, ctnConstDefinition, ctnProcedure,
3442       ctnEnumIdentifier, ctnGenericType:
3443         begin
3444           NodeText:=GetRedefinitionNodeText(Node);
3445           AVLNode:=FindCodeTreeNodeExtAVLNode(AllNodes,NodeText);
3446           if AVLNode<>nil then begin
3447             AddRedefinition(Node,TCodeTreeNodeExtension(AVLNode.Data).Node,NodeText);
3448             Node:=Node.NextSkipChilds;
3449           end else begin
3450             AddDefinition(Node,NodeText);
3451             if WithEnums
3452             and (Node.FirstChild<>nil)
3453             and (Node.FirstChild.Desc=ctnEnumerationType) then
3454               Node:=Node.FirstChild
3455             else
3456               Node:=Node.NextSkipChilds;
3457           end;
3458         end;
3459       else
3460         Node:=Node.Next;
3461       end;
3462     end;
3463   finally
3464     DisposeAVLTree(AllNodes);
3465   end;
3466   Result:=true;
3467 end;
3468 
RemoveRedefinitionsnull3469 function TCodeCompletionCodeTool.RemoveRedefinitions(
3470   TreeOfCodeTreeNodeExt: TAVLTree;
3471   SourceChangeCache: TSourceChangeCache): boolean;
3472 var
3473   AVLNode: TAVLTreeNode;
3474   NodesToDo: TAVLTree;// tree of TCodeTreeNode
3475   Node: TCodeTreeNode;
3476   StartNode: TCodeTreeNode;
3477   EndNode: TCodeTreeNode;
3478   IsListStart: Boolean;
3479   IsListEnd: Boolean;
3480   StartPos: LongInt;
3481   EndPos: LongInt;
3482 begin
3483   Result:=false;
3484   if SourceChangeCache=nil then exit;
3485   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
3486     exit(true);
3487   SourceChangeCache.MainScanner:=Scanner;
3488 
3489   NodesToDo:=TAVLTree.Create;
3490   try
3491     // put the nodes to remove into the NodesToDo
3492     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3493     while AVLNode<>nil do begin
3494       Node:=TCodeTreeNodeExtension(AVLNode.Data).Node;
3495       //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions add to NodesToDo ',GetRedefinitionNodeText(Node)]);
3496       NodesToDo.Add(Node);
3497       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3498     end;
3499 
3500     // delete all redefinitions
3501     while NodesToDo.Count>0 do begin
3502       // find a block of redefinitions
3503       StartNode:=TCodeTreeNode(NodesToDo.Root.Data);
3504       //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions StartNode=',StartNode.StartPos,' ',GetRedefinitionNodeText(StartNode)]);
3505       EndNode:=StartNode;
3506       while (StartNode.PriorBrother<>nil)
3507       and (NodesToDo.Find(StartNode.PriorBrother)<>nil) do
3508         StartNode:=StartNode.PriorBrother;
3509       while (EndNode.NextBrother<>nil)
3510       and (NodesToDo.Find(EndNode.NextBrother)<>nil) do
3511         EndNode:=EndNode.NextBrother;
3512       //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions Start=',StartNode.StartPos,' ',GetRedefinitionNodeText(StartNode),' End=',EndNode.StartPos,' ',GetRedefinitionNodeText(EndNode)]);
3513 
3514       // check if a whole section is deleted
3515       if (StartNode.PriorBrother=nil) and (EndNode.NextBrother=nil)
3516       and (StartNode.Parent<>nil)
3517       and (StartNode.Parent.Desc in AllDefinitionSections) then begin
3518         StartNode:=StartNode.Parent;
3519         EndNode:=StartNode;
3520       end;
3521 
3522       // compute nice code positions to delete
3523       StartPos:=FindLineEndOrCodeInFrontOfPosition(StartNode.StartPos);
3524       EndPos:=FindLineEndOrCodeAfterPosition(EndNode.EndPos);
3525 
3526       // check list of definitions
3527       if EndNode.Desc in AllIdentifierDefinitions then begin
3528         // check list definition. For example:
3529         //  delete, delete: char;    ->   delete whole
3530         //  a,delete, delete: char;  ->   a: char;
3531         //  delete,delete,c: char;   ->   c: char;
3532         //  a,delete,delete,c: char; ->   a,c:char;
3533         IsListStart:=(StartNode.PriorBrother=nil)
3534                  or ((StartNode.PriorBrother<>nil)
3535                      and (StartNode.PriorBrother.FirstChild<>nil));
3536         IsListEnd:=(EndNode.FirstChild<>nil);
3537         if IsListStart and IsListEnd then begin
3538           // case 1: delete, delete: char;    ->   delete whole
3539         end else begin
3540           // case 2-4: keep type
3541           // get start position of first deleting identifier
3542           StartPos:=StartNode.StartPos;
3543           // get end position of last deleting identifier
3544           EndPos:=EndNode.StartPos+GetIdentLen(@Src[EndNode.StartPos]);
3545           if IsListEnd then begin
3546             // case 2: a,delete, delete: char;  ->   a: char;
3547             // delete comma in front of start too
3548             MoveCursorToCleanPos(StartNode.PriorBrother.StartPos);
3549             ReadNextAtom; // read identifier
3550             ReadNextAtom; // read comma
3551             StartPos:=CurPos.StartPos;
3552           end else begin
3553             // case 3,4
3554             // delete comma behind end too
3555             MoveCursorToCleanPos(EndNode.StartPos);
3556             ReadNextAtom; // read identifier
3557             ReadNextAtom; // read comma
3558             EndPos:=CurPos.StartPos;
3559           end;
3560         end;
3561       end;
3562 
3563       // replace
3564       DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions deleting:']);
3565       debugln('"',copy(Src,StartPos,EndPos-StartPos),'"');
3566 
3567       if not SourceChangeCache.Replace(gtNone,gtNone,StartPos,EndPos,'') then
3568         exit;
3569 
3570       // remove nodes from NodesToDo
3571       Node:=StartNode;
3572       repeat
3573         NodesToDo.Remove(Node);
3574         //DebugLn(['TCodeCompletionCodeTool.RemoveRedefinitions removed ',Node.StartPos,' ',GetRedefinitionNodeText(Node),' ',NodesToDo.Find(Node)<>nil]);
3575         Node:=Node.Next;
3576       until (Node=nil) or
3577          ((Node.StartPos>EndNode.StartPos) and (not Node.HasAsParent(EndNode)));
3578     end;
3579   finally
3580     NodesToDo.Free;
3581   end;
3582 
3583   Result:=SourceChangeCache.Apply;
3584 end;
3585 
FindAliasDefinitionsnull3586 function TCodeCompletionCodeTool.FindAliasDefinitions(out
3587   TreeOfCodeTreeNodeExt: TAVLTree; OnlyWrongType: boolean): boolean;
3588 // finds all public definitions of the form 'const A = B;'
3589 var
3590   AllNodes: TAVLTree;
3591 
3592   procedure CheckAlias(Node: TCodeTreeNode);
3593   var
3594     ReferingNode: TCodeTreeNode;
3595     ReferingNodeText: String;
3596     ReferingPos: LongInt;
3597     NodeExt: TCodeTreeNodeExtension;
3598     BracketStartPos: LongInt;
3599     NeededType: TCodeTreeNodeDesc;
3600 
3601     procedure GetReferingNode;
3602     begin
3603       if ReferingNodeText<>'' then exit;
3604       ReferingNodeText:=GetIdentifier(@Src[ReferingPos]);
3605       NodeExt:=FindCodeTreeNodeExtWithIdentifier(AllNodes,PChar(ReferingNodeText));
3606       if (NodeExt<>nil) then
3607         ReferingNode:=NodeExt.Node;
3608     end;
3609 
3610   begin
3611     // check if definition is an alias
3612     // Example:  const A = B;  or   const A = B();
3613 
3614     if (Node.Parent=nil) then exit;
3615     if not (Node.Parent.Desc in [ctnConstSection,ctnTypeSection]) then exit;
3616     // this is a const or type
3617     MoveCursorToNodeStart(Node);
3618     // read A
3619     ReadNextAtom;
3620     if CurPos.Flag<>cafWord then exit;
3621     // read =
3622     ReadNextAtom;
3623     if CurPos.Flag<>cafEqual then exit;
3624     // read B
3625     ReadNextAtom;
3626     if CurPos.Flag<>cafWord then exit;
3627     ReferingPos:=CurPos.StartPos;
3628     ReadNextAtom;
3629     if CurPos.Flag=cafRoundBracketOpen then begin
3630       BracketStartPos:=CurPos.StartPos;
3631       ReadTilBracketClose(true);
3632       //BracketEndPos:=CurPos.StartPos;
3633       ReadNextAtom;
3634     end else
3635       BracketStartPos:=0;
3636     if CurPos.Flag<>cafSemicolon then exit;
3637 
3638     ReferingNode:=nil;
3639     NeededType:=ctnNone;
3640 
3641     if BracketStartPos>0 then begin
3642       if WordIsKeyWord.DoItCaseInsensitive(@Src[ReferingPos]) then
3643         exit;
3644       // this is a type cast
3645       NeededType:=ctnConstDefinition;
3646       //GetReferingNode;
3647       if (ReferingNode<>nil) then begin
3648         // ToDo: check if it is a typecast to a procedure type
3649         // then the alias should be replaced with a procdure
3650         //if (ReferingNode=ctnTypeDefinition)
3651       end;
3652     end else begin
3653       // this is a const or type alias
3654       //DebugLn(['TCodeCompletionCodeTool.FindAliasDefinitions Alias: ',Node.DescAsString,' ',ExtractNode(Node,[])]);
3655       GetReferingNode;
3656       if (ReferingNode<>nil) then begin
3657         NeededType:=ReferingNode.Desc;
3658       end;
3659     end;
3660     if NeededType=ctnNone then exit;
3661     // add alias
3662     if NeededType<>Node.Desc then begin
3663       DebugLn(['TCodeCompletionCodeTool.FindAliasDefinitions Wrong: ',Node.DescAsString,' ',ExtractNode(Node,[]),' ',Node.DescAsString,'<>',NodeDescToStr(NeededType)]);
3664     end;
3665     if TreeOfCodeTreeNodeExt=nil then
3666       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3667     NodeExt:=TCodeTreeNodeExtension.Create;
3668     NodeExt.Node:=Node;
3669     NodeExt.Txt:=GetRedefinitionNodeText(Node);
3670     NodeExt.Data:=ReferingNode;
3671     NodeExt.Flags:=NeededType;
3672     TreeOfCodeTreeNodeExt.Add(NodeExt);
3673   end;
3674 
3675   procedure UpdateDefinition(const NodeText: string; Node: TCodeTreeNode);
3676   var
3677     AVLNode: TAVLTreeNode;
3678     NodeExt: TCodeTreeNodeExtension;
3679   begin
3680     AVLNode:=FindCodeTreeNodeExtAVLNode(AllNodes,NodeText);
3681     if AVLNode=nil then begin
3682       // add new node
3683       NodeExt:=TCodeTreeNodeExtension.Create;
3684       NodeExt.Node:=Node;
3685       NodeExt.Txt:=NodeText;
3686       AllNodes.Add(NodeExt);
3687     end else begin
3688       // update node
3689       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3690       NodeExt.Node:=Node;
3691     end;
3692   end;
3693 
3694   procedure CollectAllDefinitions;
3695   var
3696     Node: TCodeTreeNode;
3697   begin
3698     Node:=Tree.Root;
3699     while Node<>nil do begin
3700       case Node.Desc of
3701       ctnImplementation, ctnInitialization, ctnFinalization,
3702       ctnBeginBlock, ctnAsmBlock:
3703         // skip implementation
3704         break;
3705       ctnTypeDefinition, ctnConstDefinition:
3706         begin
3707           // remember the definition
3708           UpdateDefinition(GetRedefinitionNodeText(Node),Node);
3709           Node:=Node.NextSkipChilds;
3710         end;
3711       ctnProcedure:
3712         begin
3713           UpdateDefinition(ExtractProcName(Node,[]),Node);
3714           Node:=Node.NextSkipChilds;
3715         end;
3716       else
3717         Node:=Node.Next;
3718       end;
3719     end;
3720   end;
3721 
3722   procedure CollectAllAliasDefinitions;
3723   var
3724     Node: TCodeTreeNode;
3725   begin
3726     Node:=Tree.Root;
3727     while Node<>nil do begin
3728       case Node.Desc of
3729       ctnImplementation, ctnInitialization, ctnFinalization,
3730       ctnBeginBlock, ctnAsmBlock:
3731         // skip implementation
3732         break;
3733       ctnTypeDefinition, ctnConstDefinition:
3734         begin
3735           CheckAlias(Node);
3736           Node:=Node.NextSkipChilds;
3737         end;
3738       ctnProcedure:
3739         Node:=Node.NextSkipChilds;
3740       else
3741         Node:=Node.Next;
3742       end;
3743     end;
3744   end;
3745 
3746   procedure ResolveAliases;
3747 
3748     function FindAliasRoot(Node: TCodeTreeNode;
3749       out NeededRootDesc: TCodeTreeNodeDesc): TCodeTreeNode;
3750     var
3751       AliasText: String;
3752       AVLNode: TAVLTreeNode;
3753       ReferingNode: TCodeTreeNode;
3754       OldDesc: TCodeTreeNodeDesc;
3755       NodeExt: TCodeTreeNodeExtension;
3756     begin
3757       Result:=Node;
3758       NeededRootDesc:=Node.Desc;
3759       if Node.Desc=ctnProcedure then
3760         AliasText:=ExtractProcName(Node,[])
3761       else
3762         AliasText:=GetRedefinitionNodeText(Node);
3763       if AliasText='' then exit;
3764       AVLNode:=FindCodeTreeNodeExtAVLNode(TreeOfCodeTreeNodeExt,AliasText);
3765       if AVLNode=nil then exit;
3766       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3767       NeededRootDesc:=TCodeTreeNodeDesc(NodeExt.Flags);
3768 
3769       ReferingNode:=TCodeTreeNode(NodeExt.Data);
3770       if ReferingNode=nil then exit;
3771       // this is an alias => search further
3772       if ReferingNode.Desc=ctnNone then begin
3773         // circle
3774         exit;
3775       end;
3776       // mark node as visited
3777       OldDesc:=Node.Desc;
3778       Node.Desc:=ctnNone;
3779       Result:=FindAliasRoot(ReferingNode,NeededRootDesc);
3780       // unmark node as visited
3781       Node.Desc:=OldDesc;
3782       if NeededRootDesc=ctnNone then
3783         NeededRootDesc:=Node.Desc;
3784     end;
3785 
3786   var
3787     AVLNode: TAVLTreeNode;
3788     NodeExt: TCodeTreeNodeExtension;
3789     ReferingNode: TCodeTreeNode;
3790     NeededType: TCodeTreeNodeDesc;
3791   begin
3792     if TreeOfCodeTreeNodeExt=nil then exit;
3793     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3794     while AVLNode<>nil do begin
3795       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3796       ReferingNode:=TCodeTreeNode(NodeExt.Data);
3797       if ReferingNode<>nil then begin
3798         // this node is an alias.
3799         // => find the root alias
3800         ReferingNode:=FindAliasRoot(ReferingNode,NeededType);
3801         NodeExt.Data:=ReferingNode;
3802         NodeExt.Flags:=NeededType;
3803       end;
3804       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3805     end;
3806   end;
3807 
3808   procedure RemoveGoodAliases;
3809   var
3810     AVLNode: TAVLTreeNode;
3811     NodeExt: TCodeTreeNodeExtension;
3812     NeededType: TCodeTreeNodeDesc;
3813     NextAVLNode: TAVLTreeNode;
3814   begin
3815     if TreeOfCodeTreeNodeExt=nil then exit;
3816     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3817     while AVLNode<>nil do begin
3818       NextAVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3819       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3820       NeededType:=TCodeTreeNodeDesc(NodeExt.Flags);
3821       if NodeExt.Node.Desc=NeededType then begin
3822         TreeOfCodeTreeNodeExt.FreeAndDelete(AVLNode);
3823       end;
3824       AVLNode:=NextAVLNode;
3825     end;
3826   end;
3827 
3828 begin
3829   Result:=false;
3830   TreeOfCodeTreeNodeExt:=nil;
3831   BuildTree(lsrImplementationStart);
3832 
3833   AllNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
3834   try
3835     if OnlyWrongType then
3836       CollectAllDefinitions;
3837     CollectAllAliasDefinitions;
3838     if OnlyWrongType then begin
3839       ResolveAliases;
3840       RemoveGoodAliases;
3841     end;
3842   finally
3843     DisposeAVLTree(AllNodes);
3844   end;
3845   Result:=true;
3846 end;
3847 
FixAliasDefinitionsnull3848 function TCodeCompletionCodeTool.FixAliasDefinitions(
3849   TreeOfCodeTreeNodeExt: TAVLTree; SourceChangeCache: TSourceChangeCache
3850   ): boolean;
3851 { replaces public dummy functions with a constant.
3852   The function body will be removed.
3853   See the function FindAliasDefinitions.
3854 }
3855   function FindReferingNodeExt(DefNode: TCodeTreeNode): TCodeTreeNodeExtension;
3856   var
3857     AVLNode: TAVLTreeNode;
3858     NodeExt: TCodeTreeNodeExtension;
3859   begin
3860     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3861     while AVLNode<>nil do begin
3862       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3863       if NodeExt.Node=DefNode then begin
3864         Result:=NodeExt;
3865         exit;
3866       end;
3867       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3868     end;
3869     Result:=nil;
3870   end;
3871 
3872 var
3873   AVLNode: TAVLTreeNode;
3874   NodeExt: TCodeTreeNodeExtension;
3875   DefNode: TCodeTreeNode;
3876   ReferingNode: TCodeTreeNode;
3877   NextAVLNode: TAVLTreeNode;
3878   ReferingNodeInFront: TCodeTreeNodeExtension;
3879   ReferingNodeBehind: TCodeTreeNodeExtension;
3880   NewSrc: String;
3881   FromPos: LongInt;
3882   ToPos: LongInt;
3883   ReferingType: TCodeTreeNodeDesc;
3884   NewSection: String;
3885   ProcName: String;
3886   OldProcName: String;
3887 begin
3888   Result:=false;
3889   if SourceChangeCache=nil then exit;
3890   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
3891     exit(true);
3892   SourceChangeCache.MainScanner:=Scanner;
3893 
3894   // remove all nodes which can not be handled here
3895   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3896   while AVLNode<>nil do begin
3897     NextAVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
3898     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3899     DefNode:=NodeExt.Node;
3900     ReferingType:=TCodeTreeNodeDesc(NodeExt.Flags);
3901     ReferingNode:=TCodeTreeNode(NodeExt.Data);
3902     if (ReferingType=ctnProcedure) then begin
3903       // procedure alias => check if it is an 'external' procedure
3904       if (ReferingNode=nil) or (ReferingNode.Desc<>ctnProcedure)
3905       or (not ProcNodeHasSpecifier(ReferingNode,psEXTERNAL)) then
3906         ReferingType:=ctnNone;
3907     end;
3908     if (not (ReferingType in [ctnTypeDefinition,ctnConstDefinition,ctnProcedure]))
3909     or (DefNode.Desc=ReferingType) then begin
3910       TreeOfCodeTreeNodeExt.FreeAndDelete(AVLNode);
3911     end;
3912     AVLNode:=NextAVLNode;
3913   end;
3914 
3915   // insert additional sections
3916   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
3917   while AVLNode<>nil do begin
3918     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
3919     DefNode:=NodeExt.Node;
3920     ReferingType:=TCodeTreeNodeDesc(NodeExt.Flags);
3921     ReferingNode:=TCodeTreeNode(NodeExt.Data);
3922 
3923     //DebugLn(['TCodeCompletionCodeTool.FixAliasDefinitions Old=',DefNode.DescAsString,' New=',NodeDescToStr(ReferingType)]);
3924 
3925     // check in front
3926     if ReferingType in [ctnTypeDefinition,ctnConstDefinition] then begin
3927       case ReferingType of
3928       ctnTypeDefinition: NewSection:='type';
3929       ctnConstDefinition: NewSection:='const';
3930       ctnProcedure: NewSection:=''; // Changed from NewSrc to NewSection. Is it correct? Juha
3931       else NewSection:='bug';
3932       end;
3933 
3934       if DefNode.PriorBrother=nil then begin
3935         // this is the start of the section
3936         MoveCursorToNodeStart(DefNode.Parent);
3937         ReadNextAtom;
3938         if not SourceChangeCache.Replace(gtNone,gtNone,
3939           CurPos.StartPos,CurPos.EndPos,NewSection) then exit;
3940       end else begin
3941         // this is not the start of the section
3942         ReferingNodeInFront:=FindReferingNodeExt(DefNode.PriorBrother);
3943         if (ReferingNodeInFront=nil)
3944         or (TCodeTreeNodeDesc(ReferingNodeInFront.Flags)<>ReferingType) then
3945         begin
3946           // the node in front has a different section
3947           FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
3948           if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
3949              FromPos,FromPos,NewSection) then exit;
3950         end;
3951       end;
3952     end else if ReferingType=ctnProcedure then begin
3953       // alias to an external procedure
3954       // => replace alias with complete external procedure header
3955 
3956       if DefNode.PriorBrother=nil then begin
3957         // this is the start of the section
3958         FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.Parent.StartPos);
3959         ToPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
3960         if not SourceChangeCache.Replace(gtNone,gtNone,
3961           FromPos,ToPos,'') then exit;
3962       end;
3963 
3964       NewSrc:=ExtractProcHead(ReferingNode,[phpWithStart,phpWithVarModifiers,
3965         phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
3966         phpWithOfObject,phpWithCallingSpecs,phpWithProcModifiers]);
3967       OldProcName:=ExtractProcName(ReferingNode,[]);
3968       FromPos:=System.Pos(OldProcName,NewSrc);
3969       if DefNode.Desc in [ctnTypeDefinition,ctnConstDefinition] then
3970         ProcName:=ExtractDefinitionName(DefNode)
3971       else if DefNode.Desc=ctnProcedure then
3972         ProcName:=ExtractProcName(DefNode,[])
3973       else
3974         ProcName:=NodeExt.Txt;
3975       NewSrc:=copy(NewSrc,1,FromPos-1)+ProcName
3976              +copy(NewSrc,FromPos+length(OldProcName),length(NewSrc));
3977       FromPos:=DefNode.StartPos;
3978       ToPos:=DefNode.EndPos;
3979       if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewSrc)
3980       then
3981         exit;
3982     end;
3983 
3984     // check behind
3985     if DefNode.NextBrother=nil then begin
3986       // this is the end of the section
3987     end else begin
3988       // this is not the end of the section
3989       ReferingNodeBehind:=FindReferingNodeExt(DefNode.NextBrother);
3990       if ReferingNodeBehind<>nil then begin
3991         // the next node will change the section
3992       end else begin
3993         // the next node should stay in the same type of section
3994         case DefNode.NextBrother.Desc of
3995         ctnTypeDefinition: NewSrc:='type';
3996         ctnConstDefinition: NewSrc:='const';
3997         else NewSrc:='';
3998         end;
3999         if NewSrc<>'' then begin
4000           FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.NextBrother.StartPos);
4001           if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
4002              FromPos,FromPos,NewSrc) then exit;
4003         end;
4004       end;
4005     end;
4006 
4007     AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4008   end;
4009   Result:=SourceChangeCache.Apply;
4010 end;
4011 
FindConstFunctionsnull4012 function TCodeCompletionCodeTool.FindConstFunctions(
4013   out TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4014 { find public dummy functions that can be replaced with a constant
4015   For example:
4016 
4017       function MPI_CONVERSION_FN_NULL : PMPI_Datarep_conversion_function;
4018       begin
4019          MPI_CONVERSION_FN_NULL:=PMPI_Datarep_conversion_function(0);
4020       end;
4021 
4022    Where the expression only contains unit defined types, constants,
4023    variables, built-in const functions and no members nor functions.
4024 
4025     NodeExt.Txt: description
4026     NodeExt.Node: definition node
4027     NodeExt.Data: function body node
4028     NodeExt.ExtTxt1: ExtractCode(ExprStart,ExprEnd,[]);
4029 }
4030 var
4031   Definitions: TAVLTree;
4032 
4033   function FindProcWithName(Identifier: PChar): TCodeTreeNodeExtension;
4034   begin
4035     Result:=FindCodeTreeNodeExtWithIdentifier(Definitions,Identifier);
4036   end;
4037 
4038   procedure CheckProcNode(ProcNode: TCodeTreeNode);
4039   // check if node is a function (not class function)
4040   var
4041     Node: TCodeTreeNode;
4042     FuncName: String;
4043     ExprStart: LongInt;
4044     NodeText: String;
4045     NodeExt: TCodeTreeNodeExtension;
4046     ExprEnd: LongInt;
4047     ResultNodeExt: TCodeTreeNodeExtension;
4048 
4049     function CheckExprIdentifier(Identifier: PChar): boolean;
4050     var
4051       NodeExt: TCodeTreeNodeExtension;
4052       NewPos: Integer;
4053       AtomStart: integer;
4054     begin
4055       Result:=true;
4056       if CompareIdentifiers('Result',Identifier)=0 then exit;
4057       if CompareIdentifiers(PChar(FuncName),Identifier)=0 then exit;
4058       // check for const and type definitions
4059       NodeExt:=FindCodeTreeNodeExt(Definitions,GetIdentifier(Identifier));
4060       if NodeExt=nil then
4061         NodeExt:=FindProcWithName(Identifier);
4062 
4063       if (NodeExt<>nil) and (NodeExt.Node<>nil) then begin
4064         if NodeExt.Node.Desc in [ctnConstDefinition,ctnTypeDefinition] then
4065           exit;
4066         if (NodeExt.Node.Desc=ctnProcedure) and IsPCharInSrc(Identifier) then
4067         begin
4068           // read atom behind identifier name
4069           NewPos:=PtrInt({%H-}PtrUInt(Identifier))-PtrInt({%H-}PtrUInt(@Src[1]))+1;
4070           inc(NewPos,GetIdentLen(Identifier));
4071           ReadRawNextPascalAtom(Src,NewPos,AtomStart,Scanner.NestedComments,true);
4072           if (AtomStart<=SrcLen) and (Src[AtomStart]<>'(') then begin
4073             // no parameters
4074             // this is the function pointer, not the result => constant
4075             exit;
4076           end;
4077         end;
4078       end;
4079 
4080       // check for compiler built in operators, constants and types
4081       if IsWordBuiltInFunc.DoItCaseInsensitive(Identifier) then exit;
4082       if WordIsBinaryOperator.DoItCaseInsensitive(Identifier) then exit;
4083       if WordIsPredefinedFPCIdentifier.DoItCaseInsensitive(Identifier) then exit;
4084       Result:=false;
4085     end;
4086 
4087   begin
4088     if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
4089     //DebugLn(['CheckProcNode START ',ExtractProcHead(ProcNode,[])]);
4090     MoveCursorToNodeStart(ProcNode);
4091     // read 'function'
4092     ReadNextAtom;
UNCTIONnull4093     if not UpAtomIs('FUNCTION') then exit;
4094     // read name
4095     ReadNextAtom;
4096     FuncName:=GetAtom;
4097     ReadNextAtom;
4098     if CurPos.Flag=cafRoundBracketOpen then begin
4099       // skip optional empty parameter list ()
4100       ReadNextAtom;
4101       if CurPos.Flag<>cafRoundBracketClose then exit;
4102       ReadNextAtom;
4103     end;
4104     // read :
4105     if CurPos.Flag<>cafColon then exit;
4106     // read result type
4107     ReadNextAtom;
4108     if not AtomIsIdentifier then exit;
4109 
4110     // check if there is a public definition of the procedure
4111     NodeText:=GetRedefinitionNodeText(ProcNode);
4112     if TreeOfCodeTreeNodeExt<>nil then begin
4113       ResultNodeExt:=FindCodeTreeNodeExt(TreeOfCodeTreeNodeExt,NodeText);
4114       if ResultNodeExt<>nil then begin
4115         DebugLn(['CheckProcNode function exists twice']);
4116         exit;
4117       end;
4118     end;
4119 
4120     NodeExt:=FindCodeTreeNodeExt(Definitions,NodeText);
4121     if (NodeExt=nil) or (NodeExt.Node=nil) or (NodeExt.Node.Desc<>ctnProcedure)
4122     then begin
4123       DebugLn(['CheckProcNode function is not public NodeText=',NodeText]);
4124       exit;
4125     end;
4126 
4127     // check child nodes only contain the proc head and a begin block
4128     Node:=ProcNode.FirstChild;
4129     if Node=nil then exit;
4130     if Node.Desc=ctnProcedureHead then begin
4131       Node:=Node.NextBrother;
4132       if Node=nil then exit;
4133     end;
4134     if Node.Desc<>ctnBeginBlock then exit;
4135 
4136     //DebugLn(['CheckProcNode has begin block']);
4137 
4138     // check begin block is only a single assignment
4139     MoveCursorToNodeStart(Node);
4140     // read begin
4141     ReadNextAtom;
4142     // read 'Result' or 'FunctionName'
4143     ReadNextAtom;
4144     if (not UpAtomIs('RESULT')) and (not AtomIs(FuncName)) then exit;
4145     // read :=
4146     ReadNextAtom;
4147     if not UpAtomIs(':=') then exit;
4148     // read expression
4149     ReadNextAtom;
4150     ExprStart:=CurPos.StartPos;
4151     ExprEnd:=ExprStart;
4152     while (CurPos.EndPos<=Node.EndPos) do begin
4153       if (CurPos.Flag in [cafSemicolon,cafEnd]) then
4154         break;
4155       // check if all identifiers can be used in a constant expression
4156       if AtomIsIdentifier
4157       and not CheckExprIdentifier(@Src[CurPos.StartPos]) then
4158         exit;
4159       ExprEnd:=CurPos.EndPos;
4160       ReadNextAtom;
4161     end;
4162     if ExprStart=ExprEnd then exit;
4163 
4164     //DebugLn(['CheckProcNode FOUND']);
4165 
4166     // save values
4167     ResultNodeExt:=TCodeTreeNodeExtension.Create;
4168     ResultNodeExt.Txt:=NodeText;
4169     ResultNodeExt.Node:=NodeExt.Node;
4170     ResultNodeExt.Data:=ProcNode;
4171     ResultNodeExt.ExtTxt1:=ExtractCode(ExprStart,ExprEnd,[]);
4172     if TreeOfCodeTreeNodeExt=nil then
4173       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
4174     TreeOfCodeTreeNodeExt.Add(ResultNodeExt);
4175   end;
4176 
4177 var
4178   Node: TCodeTreeNode;
4179 begin
4180   Result:=false;
4181   TreeOfCodeTreeNodeExt:=nil;
4182 
4183   try
4184     BuildTree(lsrImplementationStart);
4185 
4186     // first step: find all unit identifiers (excluding implementation section)
4187     if not GatherUnitDefinitions(Definitions,true,true) then exit;
4188     //DebugLn(['TCodeCompletionCodeTool.FindConstFunctions ',Src]);
4189 
4190     // now check all functions
4191     Node:=Tree.Root;
4192     while Node<>nil do begin
4193       case Node.Desc of
4194       ctnInterface, ctnUsesSection, ctnBeginBlock, ctnAsmBlock, ctnProcedureHead,
4195       ctnTypeSection, ctnConstSection, ctnVarSection, ctnResStrSection:
4196         Node:=Node.NextSkipChilds;
4197       ctnProcedure:
4198         begin
4199           CheckProcNode(Node);
4200           Node:=Node.NextSkipChilds;
4201         end;
4202       else
4203         Node:=Node.Next;
4204       end;
4205     end;
4206 
4207   finally
4208     DisposeAVLTree(Definitions);
4209   end;
4210   Result:=true;
4211 end;
4212 
ReplaceConstFunctionsnull4213 function TCodeCompletionCodeTool.ReplaceConstFunctions(
4214   TreeOfCodeTreeNodeExt: TAVLTree; SourceChangeCache: TSourceChangeCache
4215   ): boolean;
4216 { replaces public dummy functions with a constant.
4217   The function body will be removed.
4218   See the function FindConstFunctions.
4219 }
4220   function IsConstSectionNeeded(Node: TCodeTreeNode): boolean;
4221   var
4222     AVLNode: TAVLTreeNode;
4223     NodeExt: TCodeTreeNodeExtension;
4224   begin
4225     if Node.PriorBrother.Desc=ctnConstSection then exit(false);
4226     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4227     while AVLNode<>nil do begin
4228       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4229       if NodeExt.Node=Node.PriorBrother then begin
4230         // the function in front will be replaced too
4231         exit(false);
4232       end;
4233       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4234     end;
4235     Result:=true;
4236   end;
4237 
4238 var
4239   AVLNode: TAVLTreeNode;
4240   NodeExt: TCodeTreeNodeExtension;
4241   DefNode: TCodeTreeNode;
4242   BodyNode: TCodeTreeNode;
4243   Expr: String;
4244   FromPos: LongInt;
4245   ToPos: LongInt;
4246   NewSrc: String;
4247   Beauty: TBeautifyCodeOptions;
4248 begin
4249   Result:=false;
4250   if SourceChangeCache=nil then exit;
4251   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
4252     exit(true);
4253   SourceChangeCache.MainScanner:=Scanner;
4254   Beauty:=SourceChangeCache.BeautifyCodeOptions;
4255 
4256   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4257   while AVLNode<>nil do begin
4258     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4259     DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions ',NodeExt.Txt]);
4260     DefNode:=NodeExt.Node;
4261     BodyNode:=TCodeTreeNode(NodeExt.Data);
4262     Expr:=NodeExt.ExtTxt1;
4263     DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions Expr=',Expr]);
4264 
4265     // remove body node
4266     FromPos:=FindLineEndOrCodeInFrontOfPosition(BodyNode.StartPos);
4267     ToPos:=FindLineEndOrCodeAfterPosition(BodyNode.EndPos);
4268     if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) then begin
4269       inc(ToPos);
4270       if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13])
4271       and (Src[ToPos-1]<>Src[ToPos]) then
4272         inc(ToPos);
4273     end;
4274     DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions Body="',copy(Src,FromPos,ToPos-FromPos),'"']);
4275     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4276 
4277     // replace definition
4278     FromPos:=DefNode.StartPos;
4279     ToPos:=DefNode.EndPos;
4280     if Src[ToPos]=';' then inc(ToPos);// add semicolon
4281     NewSrc:=Beauty.GetIndentStr(Beauty.Indent)
4282       +ExtractProcName(DefNode,[])+' = '+Expr+';';
4283     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewSrc);
4284     // add 'const' keyword
4285     if IsConstSectionNeeded(DefNode) then begin
4286       FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
4287       SourceChangeCache.Replace(gtEmptyLine,gtNewLine,FromPos,FromPos,'const');
4288     end;
4289 
4290     AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4291   end;
4292   Result:=SourceChangeCache.Apply;
4293 end;
4294 
FindTypeCastFunctionsnull4295 function TCodeCompletionCodeTool.FindTypeCastFunctions(out
4296   TreeOfCodeTreeNodeExt: TAVLTree): boolean;
4297 { find public dummy functions that can be replaced with a type
4298   For example:
4299 
4300   function PMPI_Win_f2c(win : longint) : MPI_Win;
4301     begin
4302        PMPI_Win_f2c:=MPI_Win(win);
4303     end;
4304 
4305    Where the expression is Result := ResultType(Parameter).
4306 
4307     NodeExt.Txt: description
4308     NodeExt.Node: definition node
4309     NodeExt.Data: function body node
4310     NodeExt.ExtTxt1: ResultType
4311 }
4312 var
4313   Definitions: TAVLTree;
4314 
4315   procedure CheckProcNode(ProcNode: TCodeTreeNode);
4316   // check if node is a function (not class function)
4317   var
4318     Node: TCodeTreeNode;
4319     FuncName: PChar;
4320     NodeText: String;
4321     NodeExt: TCodeTreeNodeExtension;
4322     ResultNodeExt: TCodeTreeNodeExtension;
4323     ParamName: PChar;
4324     ResultType: PChar;
4325   begin
4326     if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
4327     //DebugLn(['CheckProcNode START ',ExtractProcHead(ProcNode,[])]);
4328     MoveCursorToNodeStart(ProcNode);
4329     ReadNextAtom;
4330     // read 'function'
UNCTIONnull4331     if not UpAtomIs('FUNCTION') then exit;
4332     ReadNextAtom;
4333     // read name
4334     if CurPos.Flag<>cafWord then exit;
4335     FuncName:=@Src[CurPos.StartPos];
4336     ReadNextAtom;
4337     // read (
4338     if CurPos.Flag<>cafRoundBracketOpen then exit;
4339     ReadNextAtom;
4340     // read optional const
4341     if UpAtomIs('CONST') then
4342       ReadNextAtom;
4343     // read parameter name
4344     if CurPos.Flag<>cafWord then exit;
4345     ParamName:=@Src[CurPos.StartPos];
4346     ReadNextAtom;
4347     // read :
4348     if CurPos.Flag<>cafColon then exit;
4349     ReadNextAtom;
4350     // read parameter type
4351     if CurPos.Flag<>cafWord then exit;
4352     ReadNextAtom;
4353     // read )
4354     if CurPos.Flag<>cafRoundBracketClose then exit;
4355     ReadNextAtom;
4356     // read :
4357     if CurPos.Flag<>cafColon then exit;
4358     // read result type
4359     ReadNextAtom;
4360     if CurPos.Flag<>cafWord then exit;
4361     ResultType:=@Src[CurPos.StartPos];
4362 
4363     // check if there is a public definition of the procedure
4364     NodeText:=GetRedefinitionNodeText(ProcNode);
4365     if TreeOfCodeTreeNodeExt<>nil then begin
4366       ResultNodeExt:=FindCodeTreeNodeExt(TreeOfCodeTreeNodeExt,NodeText);
4367       if ResultNodeExt<>nil then begin
4368         DebugLn(['CheckProcNode function exists twice']);
4369         exit;
4370       end;
4371     end;
4372 
4373     NodeExt:=FindCodeTreeNodeExt(Definitions,NodeText);
4374     if (NodeExt=nil) or (NodeExt.Node=nil) or (NodeExt.Node.Desc<>ctnProcedure)
4375     then begin
4376       DebugLn(['CheckProcNode function is not public NodeText=',NodeText]);
4377       exit;
4378     end;
4379 
4380     // check child nodes only contain the proc head and a begin block
4381     Node:=ProcNode.FirstChild;
4382     if Node=nil then exit;
4383     if Node.Desc=ctnProcedureHead then begin
4384       Node:=Node.NextBrother;
4385       if Node=nil then exit;
4386     end;
4387     if Node.Desc<>ctnBeginBlock then exit;
4388 
4389     //DebugLn(['CheckProcNode has begin block']);
4390 
4391     // check begin block is only a single assignment
4392     MoveCursorToNodeStart(Node);
4393     // read begin
4394     ReadNextAtom;
4395     // read 'Result' or 'FunctionName'
4396     ReadNextAtom;
4397     if CurPos.Flag<>cafWord then exit;
4398     if (not UpAtomIs('RESULT'))
4399     and (CompareIdentifiers(FuncName,@Src[CurPos.StartPos])<>0) then exit;
4400     // read :=
4401     ReadNextAtom;
4402     if not UpAtomIs(':=') then exit;
4403     // read type cast to result type
4404     ReadNextAtom;
4405     if CurPos.Flag<>cafWord then exit;
4406     if (CompareIdentifiers(ResultType,@Src[CurPos.StartPos])<>0) then exit;
4407     // read (
4408     ReadNextAtom;
4409     if CurPos.Flag<>cafRoundBracketOpen then exit;
4410     // read parameter
4411     ReadNextAtom;
4412     if CurPos.Flag<>cafWord then exit;
4413     if (CompareIdentifiers(ParamName,@Src[CurPos.StartPos])<>0) then exit;
4414     // read )
4415     ReadNextAtom;
4416     if CurPos.Flag<>cafRoundBracketClose then exit;
4417     //DebugLn(['CheckProcNode FOUND']);
4418 
4419     // save values
4420     ResultNodeExt:=TCodeTreeNodeExtension.Create;
4421     ResultNodeExt.Txt:=NodeText;
4422     ResultNodeExt.Node:=NodeExt.Node;
4423     ResultNodeExt.Data:=ProcNode;
4424     ResultNodeExt.ExtTxt1:=GetIdentifier(ResultType);
4425     if TreeOfCodeTreeNodeExt=nil then
4426       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
4427     TreeOfCodeTreeNodeExt.Add(ResultNodeExt);
4428   end;
4429 
4430 var
4431   Node: TCodeTreeNode;
4432 begin
4433   Result:=false;
4434   TreeOfCodeTreeNodeExt:=nil;
4435   try
4436     BuildTree(lsrImplementationStart);
4437 
4438     // first step: find all unit identifiers (excluding implementation section)
4439     if not GatherUnitDefinitions(Definitions,true,true) then exit;
4440 
4441     // now check all functions
4442     Node:=Tree.Root;
4443     while Node<>nil do begin
4444       case Node.Desc of
4445       ctnInterface, ctnUsesSection, ctnBeginBlock, ctnAsmBlock, ctnProcedureHead,
4446       ctnTypeSection, ctnConstSection, ctnVarSection, ctnResStrSection:
4447         Node:=Node.NextSkipChilds;
4448       ctnProcedure:
4449         begin
4450           CheckProcNode(Node);
4451           Node:=Node.NextSkipChilds;
4452         end;
4453       else
4454         Node:=Node.Next;
4455       end;
4456     end;
4457 
4458   finally
4459     DisposeAVLTree(Definitions);
4460   end;
4461   Result:=true;
4462 end;
4463 
ReplaceTypeCastFunctionsnull4464 function TCodeCompletionCodeTool.ReplaceTypeCastFunctions(
4465   TreeOfCodeTreeNodeExt: TAVLTree; SourceChangeCache: TSourceChangeCache
4466   ): boolean;
4467 { replaces public dummy functions with a type.
4468   The function body will be removed.
4469   See the function FindTypeCastFunctions.
4470 }
4471   function IsTypeSectionNeeded(Node: TCodeTreeNode): boolean;
4472   var
4473     AVLNode: TAVLTreeNode;
4474     NodeExt: TCodeTreeNodeExtension;
4475   begin
4476     if Node.PriorBrother.Desc=ctnTypeSection then exit(false);
4477     AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4478     while AVLNode<>nil do begin
4479       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4480       if NodeExt.Node=Node.PriorBrother then begin
4481         // the function in front will be replaced too
4482         exit(false);
4483       end;
4484       AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4485     end;
4486     Result:=true;
4487   end;
4488 
4489 var
4490   AVLNode: TAVLTreeNode;
4491   NodeExt: TCodeTreeNodeExtension;
4492   DefNode: TCodeTreeNode;
4493   BodyNode: TCodeTreeNode;
4494   Expr: String;
4495   FromPos: LongInt;
4496   ToPos: LongInt;
4497   NewSrc: String;
4498   Beauty: TBeautifyCodeOptions;
4499 begin
4500   Result:=false;
4501   if SourceChangeCache=nil then exit;
4502   if (TreeOfCodeTreeNodeExt=nil) or (TreeOfCodeTreeNodeExt.Count=0) then
4503     exit(true);
4504   SourceChangeCache.MainScanner:=Scanner;
4505   Beauty:=SourceChangeCache.BeautifyCodeOptions;
4506 
4507   AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
4508   while AVLNode<>nil do begin
4509     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4510     DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions ',NodeExt.Txt]);
4511     DefNode:=NodeExt.Node;
4512     BodyNode:=TCodeTreeNode(NodeExt.Data);
4513     Expr:=NodeExt.ExtTxt1;
4514     DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions Expr=',Expr]);
4515 
4516     // remove body node
4517     FromPos:=FindLineEndOrCodeInFrontOfPosition(BodyNode.StartPos);
4518     ToPos:=FindLineEndOrCodeAfterPosition(BodyNode.EndPos);
4519     if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) then begin
4520       inc(ToPos);
4521       if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13])
4522       and (Src[ToPos-1]<>Src[ToPos]) then
4523         inc(ToPos);
4524     end;
4525     DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions Body="',copy(Src,FromPos,ToPos-FromPos),'"']);
4526     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4527 
4528     // replace definition
4529     FromPos:=DefNode.StartPos;
4530     ToPos:=DefNode.EndPos;
4531     if Src[ToPos]=';' then inc(ToPos);// add semicolon
4532     NewSrc:=Beauty.GetIndentStr(Beauty.Indent)
4533       +ExtractProcName(DefNode,[])+' = '+Expr+';';
4534     SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,NewSrc);
4535     // add 'type' keyword
4536     if IsTypeSectionNeeded(DefNode) then begin
4537       FromPos:=FindLineEndOrCodeInFrontOfPosition(DefNode.StartPos);
4538       SourceChangeCache.Replace(gtEmptyLine,gtNewLine,FromPos,FromPos,'type');
4539     end;
4540 
4541     AVLNode:=TreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
4542   end;
4543   Result:=SourceChangeCache.Apply;
4544 end;
4545 
MovePointerTypesToTargetSectionsnull4546 function TCodeCompletionCodeTool.MovePointerTypesToTargetSections(
4547   SourceChangeCache: TSourceChangeCache): boolean;
4548 const
4549   NodeMovedFlag = 1;
4550 var
4551   NodeMoves: TCodeGraph;// an edge means, move the FromNode in front of the ToNode
4552   Beauty: TBeautifyCodeOptions;
4553 
4554   procedure InitNodeMoves;
4555   begin
4556     if NodeMoves=nil then
4557       NodeMoves:=TCodeGraph.Create;
4558   end;
4559 
4560   procedure ClearNodeMoves;
4561   begin
4562     FreeAndNil(NodeMoves);
4563   end;
4564 
4565   procedure AddMove(Node, InsertInFrontOf: TCodeTreeNode);
4566   begin
4567     if Node=InsertInFrontOf then exit;
4568     if Node=nil then RaiseException(20170421201640,'inconsistency');
4569     if InsertInFrontOf=nil then RaiseException(20170421201643,'inconsistency');
4570     NodeMoves.AddEdge(Node,InsertInFrontOf);
4571   end;
4572 
4573   function WholeSectionIsMoved(SectionNode: TCodeTreeNode): boolean;
4574   var
4575     Node: TCodeTreeNode;
4576     GraphNode: TCodeGraphNode;
4577   begin
4578     Node:=SectionNode.FirstChild;
4579     while Node<>nil do begin
4580       GraphNode:=NodeMoves.GetGraphNode(Node,false);
4581       if (GraphNode=nil) or (GraphNode.OutTreeCount=0) then
4582         exit(false);
4583       Node:=Node.NextBrother;
4584     end;
4585     Result:=true;
4586   end;
4587 
4588   function ApplyNodeMove(GraphNode: TCodeGraphNode; MoveNode: boolean;
4589     InsertPos, Indent: integer): boolean;
4590   // if MoveNode=true then move code of GraphNode.Node to InsertPos
4591   // Always: move recursively all nodes that should be moved to GraphNode too
4592   var
4593     AVLNode: TAVLTreeNode;
4594     GraphEdge: TCodeGraphEdge;
4595     Node: TCodeTreeNode;
4596     FromPos: LongInt;
4597     ToPos: LongInt;
4598     NodeSrc: String;
4599   begin
4600     Result:=false;
4601     Node:=GraphNode.Node;
4602     // marked as moved
4603     GraphNode.Flags:=NodeMovedFlag;
4604     DebugLn(['ApplyNodeMoves ',ExtractNode(Node,[])]);
4605     if MoveNode then begin
4606       FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4607       ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
4608       NodeSrc:=Beauty.GetIndentStr(Indent)+Trim(copy(Src,FromPos,ToPos-FromPos));
4609       // remove
4610       if (Node.PriorBrother=nil)
4611       and (Node.Parent<>nil) and (Node.Parent.Desc in AllDefinitionSections)
4612       and WholeSectionIsMoved(Node.Parent)
4613       then begin
4614         // the whole section is moved and this is the first node of the section
4615         // remove the section header too
4616         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.Parent.StartPos);
4617       end;
4618       DebugLn(['ApplyNodeMove Remove: "',copy(Src,FromPos,ToPos-FromPos),'"']);
4619       if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then exit;
4620       // insert
4621       DebugLn(['ApplyNodeMove Insert: "',NodeSrc,'"']);
4622       if not SourceChangeCache.Replace(gtNewLine,gtNewLine,
4623         InsertPos,InsertPos,NodeSrc) then exit;
4624     end;
4625     // move dependent nodes
4626     if GraphNode.InTree<>nil then begin
4627       AVLNode:=GraphNode.InTree.FindLowest;
4628       while AVLNode<>nil do begin
4629         GraphEdge:=TCodeGraphEdge(AVLNode.Data);
4630         if not ApplyNodeMove(GraphEdge.FromNode,true,InsertPos,Indent) then exit;
4631         AVLNode:=GraphNode.InTree.FindSuccessor(AVLNode);
4632       end;
4633     end;
4634     Result:=true;
4635   end;
4636 
4637   function ApplyNodeMoves(ExceptionOnCircle: boolean): boolean;
4638   var
4639     GraphEdge: TCodeGraphEdge;
4640     ListOfGraphNodes: TFPList;
4641     i: Integer;
4642     GraphNode: TCodeGraphNode;
4643     InsertPos: LongInt;
4644     Indent: LongInt;
4645   begin
4646     Result:=false;
4647     if NodeMoves.Edges.Count=0 then exit(true);
4648 
4649     // check that every node has no more than one destination
4650     GraphNode:=NodeMoves.FindGraphNodeWithNumberOfOutEdges(2,-1);
4651     if GraphNode<>nil then begin
4652       DebugLn(['TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves inconsistency: node should be moved to several places: ',ExtractNode(GraphNode.Node,[])]);
4653       raise Exception.Create('TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves node should be moved to several places');
4654     end;
4655 
4656     // sort topologically and break all circles
4657     repeat
4658       GraphEdge:=NodeMoves.GetTopologicalSortedList(ListOfGraphNodes,true,false,true);
4659       if GraphEdge=nil then break;
4660       if ExceptionOnCircle then
4661         raise Exception.Create('TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves found circle: From='+ExtractNode(GraphEdge.FromNode.Node,[])+' To='+ExtractNode(GraphEdge.ToNode.Node,[]));
4662       DebugLn(['TCodeCompletionCodeTool.MovePointerTypesToTargetSections.ApplyNodeMoves break circle: From=',ExtractNode(GraphEdge.FromNode.Node,[]),' To=',ExtractNode(GraphEdge.ToNode.Node,[])]);
4663       NodeMoves.DeleteEdge(GraphEdge);
4664       ListOfGraphNodes.Free;
4665     until false;
4666 
4667     for i:=0 to ListOfGraphNodes.Count-1 do begin
4668       GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
4669       DebugLn(['ApplyNodeMoves i=',i,' ',ExtractNode(GraphNode.Node,[]),' InFrontCnt=',GraphNode.InTreeCount,' BehindCnt=',GraphNode.OutTreeCount]);
4670     end;
4671 
4672     { apply changes
4673       the ListOfGraphNodes is sorted topologically with nodes at end must be
4674       moved first
4675       For example:
4676         var AnArray: array[0..EndValue] of char;
4677         const EndValue = TMyInteger(1);
4678         type TMyInteger = longint;
4679       Edges: TMyInteger -> AnArray
4680              EndValue -> AnArray
4681       List:
4682     }
4683     NodeMoves.ClearNodeFlags;
4684     for i:=ListOfGraphNodes.Count-1 downto 0 do begin
4685       GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
4686       if GraphNode.Flags=0 then begin
4687         InsertPos:=FindLineEndOrCodeInFrontOfPosition(GraphNode.Node.StartPos);
4688         Indent:=Beauty.GetLineIndent(Src,GraphNode.Node.StartPos);
4689         if not ApplyNodeMove(GraphNode,false,InsertPos,Indent) then exit;
4690       end;
4691     end;
4692     Result:=SourceChangeCache.Apply;
4693   end;
4694 
4695 var
4696   Definitions: TAVLTree;// tree of TCodeTreeNodeExtension
4697   Graph: TCodeGraph;
4698   AVLNode: TAVLTreeNode;
4699   NodeExt: TCodeTreeNodeExtension;
4700   Node: TCodeTreeNode;
4701   GraphNode: TCodeGraphNode;
4702   RequiredAVLNode: TAVLTreeNode;
4703   GraphEdge: TCodeGraphEdge;
4704   RequiredNode: TCodeTreeNode;
4705   RequiredTypeNode: TCodeTreeNode;
4706 begin
4707   Result:=false;
4708   if (SourceChangeCache=nil) or (Scanner=nil) then exit;
4709   NodeMoves:=nil;
4710   Definitions:=nil;
4711   Graph:=nil;
4712   Beauty:=SourceChangeCache.BeautifyCodeOptions;
4713   try
4714     // move the pointer types to the same type sections
4715     if not BuildUnitDefinitionGraph(Definitions,Graph,false) then exit;
4716     SourceChangeCache.MainScanner:=Scanner;
4717     if Definitions=nil then exit(true);
4718     InitNodeMoves;
4719 
4720     AVLNode:=Definitions.FindLowest;
4721     while AVLNode<>nil do begin
4722       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4723       Node:=NodeExt.Node;
4724       if (Node.Desc=ctnTypeDefinition) and (Node.FirstChild<>nil)
4725       and (Node.FirstChild.Desc=ctnPointerType) then begin
4726         // this is a pointer type
4727         // check if it only depends on the type nodes of a single section
4728         //DebugLn(['MovePointerTypesToTargetSections Pointer=',ExtractNode(Node,[])]);
4729         RequiredTypeNode:=nil;
4730         GraphNode:=Graph.GetGraphNode(Node,false);
4731         if GraphNode.OutTree<>nil then begin
4732           RequiredAVLNode:=GraphNode.OutTree.FindLowest;
4733           while RequiredAVLNode<>nil do begin
4734             GraphEdge:=TCodeGraphEdge(RequiredAVLNode.Data);
4735             RequiredNode:=GraphEdge.ToNode.Node;
4736             if (RequiredNode.Desc=ctnTypeDefinition)
4737             and (RequiredNode.Parent.Desc=ctnTypeSection) then begin
4738               //DebugLn(['MovePointerTypesToTargetSections required=',ExtractNode(RequiredNode,[])]);
4739               if RequiredTypeNode=nil then begin
4740                 RequiredTypeNode:=RequiredNode;
4741               end
4742               else if RequiredTypeNode.Parent<>RequiredNode.Parent then begin
4743                 DebugLn(['MovePointerTypesToTargetSections required nodes in different type sections']);
4744                 RequiredTypeNode:=nil;
4745                 break;
4746               end;
4747             end else begin
4748               DebugLn(['MovePointerTypesToTargetSections required nodes are not only types']);
4749               RequiredTypeNode:=nil;
4750               break;
4751             end;
4752             RequiredAVLNode:=GraphNode.OutTree.FindSuccessor(RequiredAVLNode);
4753           end;
4754         end;
4755         if (RequiredTypeNode<>nil) then begin
4756           // this pointer type depends only on the type nodes of a single type
4757           // section
4758           if (Node.Parent<>RequiredNode.Parent) then begin
4759             // pointer type is in other section => move
4760             DebugLn(['MovePointerTypesToTargetSections move Pointer=',ExtractNode(Node,[]),' Required=',ExtractNode(RequiredNode,[])]);
4761             AddMove(Node,RequiredNode);
4762           end;
4763         end;
4764       end;
4765       AVLNode:=Definitions.FindSuccessor(AVLNode);
4766     end;
4767     Result:=ApplyNodeMoves(false);
4768   finally
4769     DisposeAVLTree(Definitions);
4770     Graph.Free;
4771     ClearNodeMoves;
4772   end;
4773 end;
4774 
FixForwardDefinitionsnull4775 function TCodeCompletionCodeTool.FixForwardDefinitions(
4776   SourceChangeCache: TSourceChangeCache): boolean;
4777 
4778   function UpdateGraph(var Definitions: TAVLTree; var Graph: TCodeGraph;
4779     Rebuild: boolean): boolean;
4780   begin
4781     if Definitions<>nil then begin
4782       DisposeAVLTree(Definitions);
4783     end;
4784     if Graph<>nil then begin
4785       Graph.Free;
4786       Graph:=nil;
4787     end;
4788     if Rebuild then
4789       Result:=BuildUnitDefinitionGraph(Definitions,Graph,true)
4790     else
4791       Result:=true;
4792   end;
4793 
4794   function CreateTypeSectionForCycle(CycleOfGraphNodes: TFPList;
4795     var Definitions: TAVLTree; var Graph: TCodeGraph): boolean;
4796   // CycleOfGraphNodes is a list of TCodeGraphNode that should be moved
4797   // to a new type section
4798 
4799     function IndexOfNode(Node: TCodeTreeNode): integer;
4800     begin
4801       Result:=CycleOfGraphNodes.Count-1;
4802       while (Result>=0)
4803       and (TCodeGraphNode(CycleOfGraphNodes[Result]).Node<>Node) do
4804         dec(Result);
4805     end;
4806 
4807   var
4808     i: Integer;
4809     GraphNode: TCodeGraphNode;
4810     Node: TCodeTreeNode;
4811     NewTxt: String;
4812     EndGap: TGapTyp;
4813     InsertPos: LongInt;
4814     Indent: LongInt;
4815     FromPos: LongInt;
4816     ToPos: LongInt;
4817     Beauty: TBeautifyCodeOptions;
4818   begin
4819     // check if whole type sections are moved and combine them
4820     i:=CycleOfGraphNodes.Count-1;
4821     while i>=0 do begin
4822       GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4823       Node:=GraphNode.Node;
4824       if Node.Parent.Desc=ctnTypeSection then begin
4825         if IndexOfNode(Node.Parent)>=0 then begin
4826           // the whole type section of this type will be moved
4827           // => remove this type
4828           CycleOfGraphNodes.Delete(i);
4829         end else begin
4830           // check if all types of this type section will be moved
4831           Node:=Node.Parent.FirstChild;
4832           while (Node<>nil) and (IndexOfNode(Node)>=0) do
4833             Node:=Node.NextBrother;
4834           if Node=nil then begin
4835             // all types of this type section will be moved
4836             // => remove the type and add the type section instead
4837             CycleOfGraphNodes.Delete(i);
4838             CycleOfGraphNodes.Add(Graph.AddGraphNode(GraphNode.Node.Parent));
4839           end;
4840         end;
4841       end;
4842       dec(i);
4843     end;
4844 
4845     // create new type section
4846     Beauty:=SourceChangeCache.BeautifyCodeOptions;
4847     // Note: InsertPos must be outside the types and type sections which are moved
4848     GraphNode:=TCodeGraphNode(CycleOfGraphNodes[0]);
4849     Node:=GraphNode.Node;
4850     if Node.Parent.Desc=ctnTypeSection then
4851       Node:=Node.Parent;
4852     InsertPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4853     Indent:=Beauty.GetLineIndent(Src,Node.StartPos);
4854     SourceChangeCache.Replace(gtEmptyLine,gtNewLine,InsertPos,InsertPos,
4855       Beauty.GetIndentStr(Indent)+'type');
4856     inc(Indent,Beauty.Indent);
4857     // move the types
4858     for i:=0 to CycleOfGraphNodes.Count-1 do begin
4859       GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4860       Node:=GraphNode.Node;
4861       if i=CycleOfGraphNodes.Count-1 then
4862         EndGap:=gtEmptyLine
4863       else
4864         EndGap:=gtNewLine;
4865       if Node.Desc=ctnTypeSection then begin
4866         // remove type section
4867         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4868         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos,true);
4869         DebugLn(['CreateTypeSectionForCircle Removing type section: ',ExtractCode(FromPos,ToPos,[])]);
4870         SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4871         // add all types of type section to new type section
4872         if Node.FirstChild<>nil then begin
4873           FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.FirstChild.StartPos);
4874           ToPos:=FindLineEndOrCodeAfterPosition(Node.LastChild.EndPos);
4875           NewTxt:=Beauty.GetIndentStr(Indent)+ExtractCode(FromPos,ToPos,[phpWithComments]);
4876           DebugLn(['CreateTypeSectionForCircle Adding types: ',NewTxt]);
4877           SourceChangeCache.Replace(gtNewLine,EndGap,InsertPos,InsertPos,NewTxt);
4878         end;
4879       end else if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
4880         // remove type
4881         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
4882         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
4883         DebugLn(['CreateTypeSectionForCircle Removing node: ',ExtractCode(FromPos,ToPos,[])]);
4884         SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'');
4885         // add type to new type section
4886         NewTxt:=Beauty.GetIndentStr(Indent)+ExtractNode(Node,[phpWithComments]);
4887         DebugLn(['CreateTypeSectionForCircle Adding type: ',NewTxt]);
4888         SourceChangeCache.Replace(gtNewLine,EndGap,InsertPos,InsertPos,NewTxt);
4889       end else
4890         raise Exception.Create('inconsistency');
4891     end;
4892     // apply changes
4893     Result:=SourceChangeCache.Apply;
4894     if not Result then exit;
4895     // rebuild graph
4896     Result:=UpdateGraph(Definitions,Graph,true);
4897   end;
4898 
4899   function FixCycle(var Definitions: TAVLTree;
4900     var Graph: TCodeGraph; CircleNode: TCodeGraphNode): boolean;
4901   var
4902     CycleOfGraphNodes: TFPList; // list of TCodeGraphNode
4903 
4904     procedure RaiseCanNotFixCircle(const Msg: string);
4905     var
4906       i: Integer;
4907       GraphNode: TCodeGraphNode;
4908       s: String;
4909     begin
4910       DebugLn(['RaiseCanNotFixCircle Msg="',Msg,'"']);
4911       s:='Can not auto fix a circle in definitions: '+Msg;
4912       for i:=0 to CycleOfGraphNodes.Count-1 do begin
4913         GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4914         DebugLn(['  ',i,': ',GetRedefinitionNodeText(GraphNode.Node)]);
4915       end;
4916       raise Exception.Create(s);
4917     end;
4918 
4919   var
4920     i: Integer;
4921     GraphNode: TCodeGraphNode;
4922     ParentNode: TCodeTreeNode;
4923     Node: TCodeTreeNode;
4924     NeedsMoving: Boolean;
4925   begin
4926     Result:=false;
4927     CycleOfGraphNodes:=nil;
4928     try
4929       // get all nodes of this CycleOfGraphNodes
4930       Graph.GetMaximumCircle(CircleNode,CycleOfGraphNodes);
4931       // check if all nodes are types
4932       for i:=0 to CycleOfGraphNodes.Count-1 do begin
4933         GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4934         if not (GraphNode.Node.Desc in [ctnTypeDefinition,ctnGenericType])
4935         then begin
4936           RaiseCanNotFixCircle('Only types can build circles, not '+GraphNode.Node.DescAsString);
4937         end;
4938       end;
4939       NeedsMoving:=false;
4940       // check if the whole type CycleOfGraphNodes has one parent
4941       ParentNode:=TCodeGraphNode(CycleOfGraphNodes[0]).Node.Parent;
4942       for i:=1 to CycleOfGraphNodes.Count-1 do begin
4943         GraphNode:=TCodeGraphNode(CycleOfGraphNodes[i]);
4944         if GraphNode.Node.Parent<>ParentNode then begin
4945           DebugLn(['FixCycle cycle is not yet in one type section -> needs moving']);
4946           NeedsMoving:=true;
4947           break;
4948         end;
4949       end;
4950       // check if the parent only contains the CycleOfGraphNodes nodes
4951       if not NeedsMoving then begin
4952         Node:=ParentNode.FirstChild;
4953         while Node<>nil do begin
4954           i:=CycleOfGraphNodes.Count-1;
4955           while (i>=0) and (TCodeGraphNode(CycleOfGraphNodes[i]).Node<>Node) do dec(i);
4956           if i<0 then begin
4957             DebugLn(['FixCycle cycle has not yet its own type section -> needs moving']);
4958             NeedsMoving:=true;
4959             break;
4960           end;
4961           Node:=Node.NextBrother;
4962         end;
4963       end;
4964 
4965       if NeedsMoving then begin
4966         DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions.FixCycle moving types into one type section']);
4967         Result:=CreateTypeSectionForCycle(CycleOfGraphNodes,Definitions,Graph);
4968         exit;
4969       end else begin
4970         // remove definitions nodes and use the type section instead
4971         DebugLn(['FixCycle already ok']);
4972         Graph.CombineNodes(CycleOfGraphNodes,Graph.GetGraphNode(ParentNode,true));
4973       end;
4974 
4975     finally
4976       CycleOfGraphNodes.Free;
4977     end;
4978     Result:=true;
4979   end;
4980 
4981   function BreakCycles(var Definitions: TAVLTree;
4982     var Graph: TCodeGraph): boolean;
4983   var
4984     ListOfGraphNodes: TFPList;
4985     CycleEdge: TCodeGraphEdge;
4986   begin
4987     Result:=false;
4988     ListOfGraphNodes:=nil;
4989     try
4990       Graph.DeleteSelfCircles;
4991       repeat
4992         //WriteCodeGraphDebugReport(Graph);
4993         CycleEdge:=Graph.GetTopologicalSortedList(ListOfGraphNodes,true,false,false);
4994         if CycleEdge=nil then break;
4995         DebugLn(['FixForwardDefinitions.CheckCircles Circle found containing ',
4996           GetRedefinitionNodeText(CycleEdge.FromNode.Node),
4997           ' and ',
4998           GetRedefinitionNodeText(CycleEdge.ToNode.Node)]);
4999         if not FixCycle(Definitions,Graph,CycleEdge.FromNode) then exit;
5000       until false;
5001     finally
5002       ListOfGraphNodes.Free;
5003     end;
5004     Result:=true;
5005   end;
5006 
5007   function MoveNodes(TreeOfNodeMoveEdges: TAVLTree): boolean;
5008   // TreeOfNodeMoveEdges is a tree of TNodeMoveEdge
5009   // it is sorted for insert position (i.e. left node must be inserted
5010   //   in front of right node)
5011 
5012     function NodeWillBeMoved(Node: TCodeTreeNode): boolean;
5013     var
5014       AVLNode: TAVLTreeNode;
5015       CurMove: TNodeMoveEdge;
5016       GraphNode: TCodeGraphNode;
5017     begin
5018       AVLNode:=TreeOfNodeMoveEdges.FindLowest;
5019       while AVLNode<>nil do begin
5020         CurMove:=TNodeMoveEdge(AVLNode.Data);
5021         GraphNode:=CurMove.GraphNode;
5022         if GraphNode.Node=Node then exit(true);
5023         AVLNode:=TreeOfNodeMoveEdges.FindSuccessor(AVLNode);
5024       end;
5025       Result:=false;
5026     end;
5027 
5028     function GetFirstVarDefSequenceNode(Node: TCodeTreeNode): TCodeTreeNode;
5029     begin
5030       while (Node.PriorBrother<>nil) and (Node.PriorBrother.FirstChild=nil) do
5031         Node:=Node.PriorBrother;
5032       Result:=Node;
5033     end;
5034 
5035     function GetLastVarDefSequenceNode(Node: TCodeTreeNode): TCodeTreeNode;
5036     begin
5037       Result:=nil;
5038       while (Node<>nil) do begin
5039         Result:=Node;
5040         if (Node.FirstChild<>nil) then break;
5041         Node:=Node.NextBrother;
5042       end;
5043     end;
5044 
5045     function WholeVarDefSequenceWillBeMoved(Node: TCodeTreeNode): boolean;
5046     // test, if all variable definitions of a sequence will be moved
5047     // example: var a,b,c: integer;
5048     begin
5049       Node:=GetFirstVarDefSequenceNode(Node);
5050       while (Node<>nil) do begin
5051         if not NodeWillBeMoved(Node) then exit(false);
5052         if (Node.FirstChild<>nil) then break;// this is the last of the sequence
5053         Node:=Node.NextBrother;
5054       end;
5055       Result:=true;
5056     end;
5057 
5058     function WholeSectionWillBeMoved(Node: TCodeTreeNode): boolean;
5059     // test, if all child nodes will be moved
5060     begin
5061       Node:=Node.FirstChild;
5062       while (Node<>nil) do begin
5063         if not NodeWillBeMoved(Node) then exit(false);
5064         Node:=Node.NextBrother;
5065       end;
5066       Result:=true;
5067     end;
5068 
5069   var
5070     AVLNode: TAVLTreeNode;
5071     CurMove: TNodeMoveEdge;
5072     GraphNode: TCodeGraphNode;// move what
5073     PosGraphNode: TCodeGraphNode;// move where (in front of)
5074     Node: TCodeTreeNode;
5075     FromPos: LongInt;
5076     ToPos: LongInt;
5077     DestNode: TCodeTreeNode;
5078     NextAVLNode: TAVLTreeNode;
5079     NextMove: TNodeMoveEdge;
5080     NextGraphNode: TCodeGraphNode;// move what next
5081     NextPosGraphNode: TCodeGraphNode;// move where next (in front of)
5082     NextInsertAtSamePos: boolean;
5083     NeedSection: TCodeTreeNodeDesc;
5084     LastSection: TCodeTreeNodeDesc;
5085     LastInsertAtSamePos: boolean;
5086     InsertPos: LongInt;
5087     Indent: LongInt;
5088     DestSection: TCodeTreeNodeDesc;
5089     NewTxt: String;
5090     DestNodeInFront: TCodeTreeNode;
5091     Beauty: TBeautifyCodeOptions;
5092   begin
5093     Result:=false;
5094     AVLNode:=TreeOfNodeMoveEdges.FindLowest;
5095     LastSection:=ctnNone;
5096     LastInsertAtSamePos:=false;
5097     DestNode:=nil;
5098     DestSection:=ctnNone;
5099     Beauty:=SourceChangeCache.BeautifyCodeOptions;
5100     // process every move
5101     while AVLNode<>nil do begin
5102       CurMove:=TNodeMoveEdge(AVLNode.Data);
5103       GraphNode:=CurMove.GraphNode;// move what
5104       PosGraphNode:=TCodeGraphNode(GraphNode.Data);// move where (in front of)
5105       NextAVLNode:=TreeOfNodeMoveEdges.FindSuccessor(AVLNode);
5106       if NextAVLNode<>nil then begin
5107         NextMove:=TNodeMoveEdge(NextAVLNode.Data);
5108         NextGraphNode:=NextMove.GraphNode;// move what next
5109         NextPosGraphNode:=TCodeGraphNode(NextGraphNode.Data);// move where next
5110         NextInsertAtSamePos:=NextPosGraphNode=PosGraphNode;
5111       end else begin
5112         NextInsertAtSamePos:=false;
5113       end;
5114       DebugLn(['MoveNodes: move ',
5115         GetRedefinitionNodeText(GraphNode.Node),' ',CleanPosToStr(GraphNode.Node.StartPos),
5116         ' (TopoLvl=',CurMove.TologicalLevel,')',
5117         ' in front of ',GetRedefinitionNodeText(PosGraphNode.Node),' ',CleanPosToStr(PosGraphNode.Node.StartPos)
5118         ]);
5119       Node:=GraphNode.Node;
5120       DestNode:=PosGraphNode.Node;
5121 
5122       // remove node
5123       if (Node.Parent<>nil)
5124       and (Node.Parent.Desc in AllDefinitionSections)
5125       and WholeSectionWillBeMoved(Node.Parent) then begin
5126         // the whole type/var/const section will be moved
5127         if Node.PriorBrother=nil then begin
5128           // this is the first node of the section
5129           // => remove the whole section
5130           FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.Parent.StartPos);
5131           ToPos:=FindLineEndOrCodeAfterPosition(Node.Parent.EndPos,true);
5132         end else begin
5133           // this is not the first node of the section
5134           // => remove nothing
5135           FromPos:=0;
5136           ToPos:=0;
5137         end;
5138       end
5139       else if Node.Desc=ctnVarDefinition then begin
5140         // removing a variable definition can be tricky, because for example
5141         // var a,b,c: integer;
5142         if Node.FirstChild<>nil then begin
5143           // this is the last of a sequence
5144           if WholeVarDefSequenceWillBeMoved(Node) then begin
5145             // the whole variable definition will be moved
5146             // and this is the last of the sequence
5147             // => remove the whole definition (names and type)
5148             FromPos:=FindLineEndOrCodeInFrontOfPosition(
5149                                      GetFirstVarDefSequenceNode(Node).StartPos);
5150             ToPos:=FindLineEndOrCodeAfterPosition(
5151                                    GetLastVarDefSequenceNode(Node).EndPos,true);
5152           end else if NodeWillBeMoved(Node.PriorBrother) then begin
5153             // this is for example: var a,b,c: integer
5154             // and only b and c will be moved. The b, plus the space behind was
5155             // already marked for removal
5156             // => remove the c and the space behind
5157             FromPos:=Node.StartPos;
5158             MoveCursorToNodeStart(Node);
5159             ReadNextAtom;// read identifier
5160             AtomIsIdentifierE;
5161             ToPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos,true);
5162           end else begin
5163             // this is for example: var a,b: integer
5164             // and only b will be moved.
5165             // => remove ,b plus the space behind
5166             MoveCursorToNodeStart(Node.PriorBrother);
5167             ReadNextAtom;// read identifier
5168             AtomIsIdentifierE;
5169             ReadNextAtom;// read comma
5170             if not AtomIsChar(',') then RaiseCharExpectedButAtomFound(20170421201647,',');
5171             FromPos:=CurPos.StartPos;
5172             ReadNextAtom;// read identifier
5173             AtomIsIdentifierE;
5174             ReadNextAtom;//read colon
5175             if not AtomIsChar(':') then RaiseCharExpectedButAtomFound(20170421201651,':');
5176             ToPos:=CurPos.StartPos;
5177           end;
5178         end else begin
5179           // this is not the last of a sequence
5180           if WholeVarDefSequenceWillBeMoved(Node) then begin
5181             // the whole sequence will be moved. This is done by the last node.
5182             // => nothing to do
5183             FromPos:=0;
5184             ToPos:=0;
5185           end else begin
5186             // remove the b,
5187             FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
5188             MoveCursorToNodeStart(Node);
5189             ReadNextAtom;// read identifier
5190             AtomIsIdentifierE;
5191             ReadNextAtom;// read comma
5192             if not AtomIsChar(',') then RaiseCharExpectedButAtomFound(20170421201654,',');
5193             ToPos:=CurPos.StartPos;
5194           end;
5195         end;
5196       end else begin
5197         // remove the whole node
5198         FromPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
5199         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
5200       end;
5201       if ToPos>FromPos then begin
5202         DebugLn(['MoveNodes remove "',ExtractCode(FromPos,ToPos,[]),'"']);
5203         if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then
5204           exit;
5205       end;
5206 
5207       // find needed section type
5208       if Node.Desc in AllIdentifierDefinitions then
5209         NeedSection:=Node.Parent.Desc
5210       else
5211         NeedSection:=ctnNone;
5212 
5213       // find insert position
5214       if not LastInsertAtSamePos then begin
5215         //DebugLn(['MoveNodes LastInsertAtSamePos=false, compute destination ...']);
5216         if (DestNode.Desc in AllIdentifierDefinitions) then begin
5217           DestNode:=GetFirstVarDefSequenceNode(DestNode);
5218           DestSection:=DestNode.Parent.Desc;
5219           if DestNode.PriorBrother<>nil then begin
5220             // the destination is in front of a definition, but in the middle
5221             // of a section
5222             // example: type a=char; | b=byte;
5223             // => insert in front of destination
5224             //DebugLn(['MoveNodes destination is middle of a section. Node in front=',GetRedefinitionNodeText(DestNode.PriorBrother)]);
5225           end else begin
5226             // the destination is the first node of a section
5227             // example: type | t=char;
5228             if NeedSection=DestSection then begin
5229               // insertion needs the same section type
5230               // => insert in front of destination
5231             end else begin
5232               // insertion needs another section type
5233               // => insert in front of the section
5234               DestNode:=DestNode.Parent;
5235             end;
5236             //DebugLn(['MoveNodes destination is first node of a section ']);
5237           end;
5238         end else begin
5239           // the destination is not in a section
5240           // example: in front of a type section
5241           // => insert in front of destination
5242           // find the section in front
5243           DestNodeInFront:=DestNode.PriorBrother;
5244           while (DestNodeInFront<>nil) and NodeWillBeMoved(DestNodeInFront) do
5245             DestNodeInFront:=DestNodeInFront.PriorBrother;
5246           if (DestNodeInFront<>nil)
5247           and (DestNodeInFront.Desc in AllDefinitionSections) then
5248             DestSection:=DestNodeInFront.Desc
5249           else
5250             DestSection:=ctnNone;
5251           //DebugLn(['MoveNodes destination is not in a section']);
5252         end;
5253         InsertPos:=FindLineEndOrCodeAfterPosition(DestNode.StartPos);
5254         Indent:=Beauty.GetLineIndent(Src,DestNode.StartPos);
5255         //DebugLn(['MoveNodes DestNode=',GetRedefinitionNodeText(DestNode),':',DestNode.DescAsString,' DestSection=',NodeDescToStr(DestSection)]);
5256       end;
5257 
5258       // start a new section if needed
5259       //DebugLn(['MoveNodes LastInsertAtSamePos=',LastInsertAtSamePos,' NeedSection=',NodeDescToStr(NeedSection),' LastSection=',NodeDescToStr(LastSection),' DestSection=',NodeDescToStr(DestSection)]);
5260       if (LastInsertAtSamePos and (NeedSection<>LastSection))
5261       or ((not LastInsertAtSamePos) and (NeedSection<>DestSection)) then begin
5262         // start a new section
5263         case NeedSection of
5264         ctnVarSection: NewTxt:='var';
5265         ctnConstSection: NewTxt:='const';
5266         ctnResStrSection: NewTxt:='resourcestring';
5267         ctnTypeSection: NewTxt:='type';
5268         ctnLabelSection: NewTxt:='label';
5269         else NewTxt:='';
5270         end;
5271         if NewTxt<>'' then begin
5272           DebugLn(['MoveNodes start new section: insert "',NewTxt,'"']);
5273           if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
5274                                            InsertPos,InsertPos,NewTxt)
5275           then
5276             exit;
5277           Indent:=Beauty.Indent;
5278         end;
5279       end;
5280 
5281       // insert node
5282       if Node.Desc=ctnVarDefinition then begin
5283         NewTxt:=GetIdentifier(@Src[Node.StartPos]);
5284         MoveCursorToNodeStart(GetLastVarDefSequenceNode(Node));
5285         ReadNextAtom;
5286         AtomIsIdentifierE;
5287         ReadNextAtom;
5288         if not AtomIsChar(':') then RaiseCharExpectedButAtomFound(20170421201657,':');
5289         FromPos:=CurPos.StartPos;
5290         ToPos:=Node.EndPos;
5291         NewTxt:=NewTxt+ExtractCode(FromPos,ToPos,[phpWithComments]);
5292       end else begin
5293         FromPos:=Node.StartPos;
5294         ToPos:=FindLineEndOrCodeAfterPosition(Node.EndPos);
5295         NewTxt:=ExtractCode(FromPos,ToPos,[phpWithComments]);
5296       end;
5297       NewTxt:=Beauty.GetIndentStr(Indent)+NewTxt;
5298       DebugLn(['MoveNodes insert "',NewTxt,'"']);
5299       if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
5300         NewTxt) then exit;
5301 
5302       // restore destination section if needed
5303       if not NextInsertAtSamePos then begin
5304         // this was the last insertion at this destination
5305         DebugLn(['MoveNodes this was the last insertion at this dest NeedSection=',NodeDescToStr(NeedSection),' DestSection=',NodeDescToStr(DestSection)]);
5306         if (DestNode.Desc in AllIdentifierDefinitions)
5307         and (NeedSection<>DestSection)
5308         and (DestSection in AllDefinitionSections) then begin
5309           // restore the section of destination
5310           case DestSection of
5311           ctnVarSection: NewTxt:='var';
5312           ctnConstSection: NewTxt:='const';
5313           ctnResStrSection: NewTxt:='resourcestring';
5314           ctnTypeSection: NewTxt:='type';
5315           ctnLabelSection: NewTxt:='label';
5316           else NewTxt:='';
5317           end;
5318           if NewTxt<>'' then begin
5319             DebugLn(['MoveNodes restore destination  section: insert "',NewTxt,'"']);
5320             if not SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
5321                                              InsertPos,InsertPos,NewTxt)
5322             then
5323               exit;
5324           end;
5325         end;
5326       end;
5327 
5328       LastSection:=NeedSection;
5329       LastInsertAtSamePos:=NextInsertAtSamePos;
5330       AVLNode:=NextAVLNode;
5331     end;
5332     Result:=SourceChangeCache.Apply;
5333   end;
5334 
5335   function CheckOrder(var Definitions: TAVLTree;
5336     var Graph: TCodeGraph): boolean;
5337   // sort definitions topologically in source
5338   // the Graph must be acyclic
5339   var
5340     ListOfGraphNodes: TFPList;
5341     CircleEdge: TCodeGraphEdge;
5342     i: Integer;
5343     GraphNode: TCodeGraphNode;
5344     AVLNode: TAVLTreeNode;
5345     UsedByGraphNode: TCodeGraphNode;
5346     PosGraphNode: TCodeGraphNode;
5347     PosUsedByGraphNode: TCodeGraphNode;
5348     NodeMoveEdges: TAVLTree;
5349     NewMoveEdge: TNodeMoveEdge;
5350   begin
5351     Result:=false;
5352     ListOfGraphNodes:=nil;
5353     NodeMoveEdges:=TAVLTree.Create(@CompareNodeMoveEdges);
5354     try
5355       //WriteCodeGraphDebugReport(Graph);
5356 
5357       // create a topologically sorted list
5358       CircleEdge:=Graph.GetTopologicalSortedList(ListOfGraphNodes,false,true,false);
5359       if CircleEdge<>nil then
5360         raise Exception.Create('not acyclic');
5361 
5362       { set the GraphNode.Data to those GraphNodes leaves
5363         with the lowest Node.StartPos
5364         For example:
5365           var AnArray: array[0..EndValue] of char;
5366           const EndValue = TMyInteger(1);
5367           type TMyInteger = integer;
5368         EndValue must be moved in front of AnArray
5369         and TMyInteger must be moved in front of EndValue and AnArray.
5370         The topological list gives:
5371           TMyInteger
5372           EndValue
5373           AnArray
5374         NOTE: topological order alone can not be used,
5375           because unrelated definitions will be mixed somehow.
5376       }
5377       // init the destinations
5378       for i:=0 to ListOfGraphNodes.Count-1 do begin
5379         GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
5380         //DebugLn(['CheckOrder ',GetRedefinitionNodeText(GraphNode.Node)]);
5381         GraphNode.Data:=GraphNode;
5382       end;
5383       // calculate the destinations as minimum of all dependencies
5384       for i:=ListOfGraphNodes.Count-1 downto 0 do begin
5385         GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
5386         if GraphNode.InTree<>nil then begin
5387           AVLNode:=GraphNode.InTree.FindLowest;
5388           while AVLNode<>nil do begin
5389             UsedByGraphNode:=TCodeGraphEdge(AVLNode.Data).FromNode;
5390             // for example: type TMyPointer = TMyInteger;
5391             // GraphNode.Node is TMyInteger
5392             // UsedByGraphNode.Node is TMyPointer
5393             //DebugLn(['CheckOrder GraphNode=',GetRedefinitionNodeText(GraphNode.Node),' UsedBy=',GetRedefinitionNodeText(UsedByGraphNode.Node)]);
5394             PosGraphNode:=TCodeGraphNode(GraphNode.Data);
5395             PosUsedByGraphNode:=TCodeGraphNode(UsedByGraphNode.Data);
5396             if PosGraphNode.Node.StartPos>PosUsedByGraphNode.Node.StartPos then
5397               GraphNode.Data:=PosUsedByGraphNode;
5398             AVLNode:=GraphNode.InTree.FindSuccessor(AVLNode);
5399           end;
5400         end;
5401       end;
5402       // create the list of moves
5403       // sorted for: 1. destination position,
5404       //             2. topological level,
5405       //             3. origin position in source
5406       for i:=0 to ListOfGraphNodes.Count-1 do begin
5407         GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
5408         PosGraphNode:=TCodeGraphNode(GraphNode.Data);
5409         if GraphNode<>PosGraphNode then begin
5410           DebugLn(['CheckOrder Move: ',
5411             GetRedefinitionNodeText(GraphNode.Node),' ',CleanPosToStr(GraphNode.Node.StartPos),
5412             ' TopoLvl=',GraphNode.Flags,
5413             ' in front of ',GetRedefinitionNodeText(PosGraphNode.Node),' ',CleanPosToStr(PosGraphNode.Node.StartPos)
5414             ]);
5415           NewMoveEdge:=TNodeMoveEdge.Create;
5416           NewMoveEdge.GraphNode:=GraphNode;
5417           NewMoveEdge.DestPos:=PosGraphNode.Node.StartPos;
5418           NewMoveEdge.TologicalLevel:=GraphNode.Flags;
5419           NewMoveEdge.SrcPos:=GraphNode.Node.StartPos;
5420           NodeMoveEdges.Add(NewMoveEdge);
5421         end;
5422       end;
5423 
5424       Result:=MoveNodes(NodeMoveEdges);
5425       // ToDo: maybe need UpdateGraph?
5426       if Definitions<>nil then ;
5427     finally
5428       DisposeAVLTree(NodeMoveEdges);
5429       ListOfGraphNodes.Free;
5430     end;
5431   end;
5432 
5433 var
5434   Definitions: TAVLTree;
5435   Graph: TCodeGraph;
5436 begin
5437   Result:=false;
5438   if (SourceChangeCache=nil) or (Scanner=nil) then begin
5439     DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions no scanner']);
5440     exit;
5441   end;
5442   Definitions:=nil;
5443   Graph:=nil;
5444   try
5445     // Workaround:
5446     // move the pointer types to the same type sections
5447     //if not MovePointerTypesToTargetSections(SourceChangeCache) then exit;
5448     //exit(true);
5449 
5450     if not BuildUnitDefinitionGraph(Definitions,Graph,true) then begin
5451       DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions BuildUnitDefinitionGraph failed']);
5452       exit;
5453     end;
5454     if Graph=nil then begin
5455       // no definitions found
5456       exit(true);
5457     end;
5458     SourceChangeCache.MainScanner:=Scanner;
5459     // fix cycles
5460     if not BreakCycles(Definitions,Graph) then begin
5461       DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions CheckCircles failed']);
5462       exit;
5463     end;
5464     // now the graph is acyclic and nodes can be moved
5465     if not CheckOrder(Definitions,Graph) then begin
5466       DebugLn(['TCodeCompletionCodeTool.FixForwardDefinitions CheckOrder failed']);
5467       exit;
5468     end;
5469   finally
5470     UpdateGraph(Definitions,Graph,false);
5471   end;
5472   Result:=true;
5473 end;
5474 
GatherUnitDefinitionsnull5475 function TCodeCompletionCodeTool.GatherUnitDefinitions(out
5476   TreeOfCodeTreeNodeExt: TAVLTree;
5477   OnlyInterface, ExceptionOnRedefinition: boolean): boolean;
5478 
5479   procedure RaiseRedefinition(Node1, Node2: TCodeTreeNode);
5480   begin
5481     MoveCursorToNodeStart(Node1);
5482     RaiseException(20170421201704,'redefinition found: '+GetRedefinitionNodeText(Node1)
5483       +' at '+CleanPosToStr(Node1.StartPos)
5484       +' and at '+CleanPosToStr(Node2.StartPos));
5485   end;
5486 
5487   procedure AddDefinition(Node: TCodeTreeNode);
5488   var
5489     NodeExt: TCodeTreeNodeExtension;
5490     NodeText: String;
5491   begin
5492     NodeText:=GetRedefinitionNodeText(Node);
5493     NodeExt:=FindCodeTreeNodeExt(TreeOfCodeTreeNodeExt,NodeText);
5494     if NodeExt<>nil then begin
5495       if NodeIsForwardProc(NodeExt.Node)
5496       and (not NodeIsForwardProc(Node)) then begin
5497         // this is the procedure body of the forward definition -> skip
5498         exit;
5499       end;
5500       if ExceptionOnRedefinition then
5501         RaiseRedefinition(NodeExt.Node,Node);
5502     end;
5503     NodeExt:=TCodeTreeNodeExtension.Create;
5504     NodeExt.Txt:=NodeText;
5505     TreeOfCodeTreeNodeExt.Add(NodeExt);
5506     NodeExt.Node:=Node;
5507   end;
5508 
5509 var
5510   Node: TCodeTreeNode;
5511 begin
5512   Result:=false;
5513   TreeOfCodeTreeNodeExt:=nil;
5514   if OnlyInterface then
5515     BuildTree(lsrImplementationStart)
5516   else
5517     BuildTree(lsrInitializationStart);
5518 
5519   // find all unit identifiers (excluding sub types)
5520   TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
5521   Node:=Tree.Root;
5522   while Node<>nil do begin
5523     case Node.Desc of
5524     ctnProcedureHead, ctnParameterList, ctnInitialization, ctnFinalization,
5525     ctnBeginBlock, ctnAsmBlock:
5526       Node:=Node.NextSkipChilds;
5527     ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnEnumIdentifier,
5528     ctnGenericType:
5529       begin
5530         // add or update definition
5531         AddDefinition(Node);
5532 
5533         if (Node.Desc=ctnTypeDefinition)
5534         and (Node.FirstChild<>nil)
5535         and (Node.FirstChild.Desc=ctnEnumerationType) then
5536           Node:=Node.FirstChild
5537         else
5538           Node:=Node.NextSkipChilds;
5539       end;
5540     ctnProcedure:
5541       begin
5542         AddDefinition(Node);
5543         Node:=Node.NextSkipChilds;
5544       end;
5545     else
5546       if OnlyInterface and (Node.Desc=ctnImplementation) then
5547         break;
5548       Node:=Node.Next;
5549     end;
5550   end;
5551 
5552   Result:=true;
5553 end;
5554 
BuildUnitDefinitionGraphnull5555 function TCodeCompletionCodeTool.BuildUnitDefinitionGraph(out
5556   DefinitionsTreeOfCodeTreeNodeExt: TAVLTree; out Graph: TCodeGraph;
5557   OnlyInterface: boolean): boolean;
5558 
5559   procedure CheckRange(Node: TCodeTreeNode; FromPos, ToPos: integer);
5560   // search the range for defined identifiers
5561   // and add edges to graph
5562   var
5563     Identifier: PChar;
5564     NodeExt: TCodeTreeNodeExtension;
5565   begin
5566     if (FromPos>=ToPos) or (FromPos<1) then exit;
5567     //DebugLn(['CheckRange Range="',dbgstr(Src[FromPos..ToPos-1]),'"']);
5568     MoveCursorToCleanPos(FromPos);
5569     repeat
5570       ReadNextAtom;
5571       if (CurPos.StartPos>=ToPos) or (CurPos.StartPos>SrcLen) then break;
5572       if AtomIsIdentifier then begin
5573         Identifier:=@Src[CurPos.StartPos];
5574         NodeExt:=FindCodeTreeNodeExtWithIdentifier(
5575                                      DefinitionsTreeOfCodeTreeNodeExt,
5576                                      Identifier);
5577         if NodeExt<>nil then begin
5578           if Graph=nil then
5579             Graph:=TCodeGraph.Create;
5580           //if Graph.GetEdge(Node,NodeExt.Node,false)=nil then
5581           //  DebugLn(['CheckRange AddEdge: ',GetRedefinitionNodeText(Node),' uses ',GetRedefinitionNodeText(NodeExt.Node)]);
5582           Graph.AddEdge(Node,NodeExt.Node);
5583         end;
5584       end;
5585     until false;
5586   end;
5587 
5588   procedure CheckSubNode(Node, SubNode: TCodeTreeNode);
5589   var
5590     ProcHead: TCodeTreeNode;
5591     ParamList: TCodeTreeNode;
5592     ChildNode: TCodeTreeNode;
5593     FunctionResult: TCodeTreeNode;
5594   begin
5595     //DebugLn(['CheckSubNode ',GetRedefinitionNodeText(Node),' ',GetRedefinitionNodeText(SubNode)]);
5596     case SubNode.Desc of
5597 
5598     ctnTypeDefinition,ctnVarDefinition,ctnGenericType,ctnConstDefinition:
5599       begin
5600         ChildNode:=FindTypeNodeOfDefinition(SubNode);
5601         if ChildNode<>nil then begin
5602           CheckSubNode(Node,ChildNode);
5603         end else if SubNode.Desc=ctnConstDefinition then begin
5604           CheckRange(Node,ChildNode.StartPos,SubNode.EndPos);
5605         end;
5606       end;
5607 
5608     ctnProcedure:
5609       begin
5610         BuildSubTreeForProcHead(SubNode,FunctionResult);
5611         ProcHead:=SubNode.FirstChild;
5612         ParamList:=ProcHead.FirstChild;
5613         if ParamList<>nil then begin
5614           ChildNode:=ParamList.FirstChild;
5615           while ChildNode<>nil do begin
5616             if (ChildNode.Desc=ctnVarDefinition) and (ChildNode.FirstChild<>nil)
5617             then begin
5618               CheckRange(Node,ChildNode.FirstChild.StartPos,ChildNode.EndPos);
5619             end;
5620             ChildNode:=ChildNode.NextBrother;
5621           end;
5622         end;
5623         if FunctionResult<>nil then begin
5624           CheckRange(Node,FunctionResult.StartPos,
5625                      FunctionResult.StartPos
5626                      +GetIdentLen(@Src[FunctionResult.StartPos]));
5627         end;
5628       end;
5629 
5630     ctnClassInterface, ctnDispinterface, ctnClass, ctnObject, ctnRecordType,
5631     ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
5632     ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
5633       begin
5634         ChildNode:=SubNode.FirstChild;
5635         while (ChildNode<>nil) and (ChildNode.HasAsParent(SubNode)) do begin
5636           if ChildNode.Desc in AllIdentifierDefinitions then begin
5637             CheckSubNode(Node,ChildNode);
5638             ChildNode:=ChildNode.NextSkipChilds;
5639           end else
5640             ChildNode:=ChildNode.Next;
5641         end;
5642       end;
5643 
5644     else
5645       CheckRange(Node,SubNode.StartPos,SubNode.Parent.EndPos);
5646     end;
5647   end;
5648 
5649 var
5650   AVLNode: TAVLTreeNode;
5651   NodeExt: TCodeTreeNodeExtension;
5652   Node: TCodeTreeNode;
5653 begin
5654   Result:=false;
5655   DefinitionsTreeOfCodeTreeNodeExt:=nil;
5656   Graph:=nil;
5657   if not GatherUnitDefinitions(DefinitionsTreeOfCodeTreeNodeExt,OnlyInterface,true) then
5658   begin
5659     DebugLn(['TCodeCompletionCodeTool.BuildUnitDefinitionGraph GatherUnitDefinitions failed']);
5660     exit;
5661   end;
5662   if DefinitionsTreeOfCodeTreeNodeExt=nil then exit(true);
5663 
5664   AVLNode:=DefinitionsTreeOfCodeTreeNodeExt.FindLowest;
5665   while AVLNode<>nil do begin
5666     NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5667     Node:=NodeExt.Node;
5668     CheckSubNode(Node,Node);
5669     AVLNode:=DefinitionsTreeOfCodeTreeNodeExt.FindSuccessor(AVLNode);
5670   end;
5671 
5672   Result:=true;
5673 end;
5674 
5675 procedure TCodeCompletionCodeTool.WriteCodeGraphDebugReport(Graph: TCodeGraph);
5676 
5677   function NodeToStr(Node: TCodeTreeNode): string;
5678   begin
5679     case Node.Desc of
5680     ctnProcedure:
5681       Result:=ExtractProcHead(Node,[phpInUpperCase,phpWithoutSemicolon]);
5682     ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnEnumIdentifier,
5683     ctnGenericType:
5684       Result:=ExtractDefinitionName(Node);
5685     else
5686       Result:=Node.DescAsString;
5687     end;
5688     Result:=Result+'{'+CleanPosToStr(Node.StartPos)+'}';
5689   end;
5690 
5691 var
5692   AVLNode: TAVLTreeNode;
5693   GraphNode: TCodeGraphNode;
5694   Node: TCodeTreeNode;
5695   Cnt: LongInt;
5696   EdgeAVLNode: TAVLTreeNode;
5697   Edge: TCodeGraphEdge;
5698 begin
5699   DebugLn(['TCodeCompletionCodeTool.WriteCodeGraphDebugReport ',DbgSName(Graph),
5700     ' NodeCount=',Graph.Nodes.Count,
5701     ' EdgeCount=',Graph.Edges.Count]);
5702   Graph.ConsistencyCheck;
5703   AVLNode:=Graph.Nodes.FindLowest;
5704   while AVLNode<>nil do begin
5705     GraphNode:=TCodeGraphNode(AVLNode.Data);
5706     Node:=GraphNode.Node;
5707     DebugLn(['  ',NodeToStr(Node),' needs ',GraphNode.OutTreeCount,' definitions, is used by ',GraphNode.InTreeCount,' definitions.']);
5708     if GraphNode.OutTreeCount>0 then begin
5709       DbgOut('    Needs:');
5710       EdgeAVLNode:=GraphNode.OutTree.FindLowest;
5711       Cnt:=0;
5712       while EdgeAVLNode<>nil do begin
5713         inc(Cnt);
5714         if Cnt=5 then begin
5715           DbgOut(' ...');
5716           break;
5717         end;
5718         Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
5719         DbgOut(' '+NodeToStr(Edge.ToNode.Node));
5720         EdgeAVLNode:=GraphNode.OutTree.FindSuccessor(EdgeAVLNode);
5721       end;
5722       DebugLn;
5723     end;
5724     if GraphNode.InTreeCount>0 then begin
5725       DbgOut('    Used by:');
5726       EdgeAVLNode:=GraphNode.InTree.FindLowest;
5727       Cnt:=0;
5728       while EdgeAVLNode<>nil do begin
5729         inc(Cnt);
5730         if Cnt=5 then begin
5731           DbgOut(' ...');
5732           break;
5733         end;
5734         Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
5735         DbgOut(' '+NodeToStr(Edge.FromNode.Node));
5736         EdgeAVLNode:=GraphNode.InTree.FindSuccessor(EdgeAVLNode);
5737       end;
5738       DebugLn;
5739     end;
5740     AVLNode:=Graph.Nodes.FindSuccessor(AVLNode);
5741   end;
5742 end;
5743 
FindEmptyMethodsnull5744 function TCodeCompletionCodeTool.FindEmptyMethods(CursorPos: TCodeXYPosition;
5745   const AClassName: string; const Sections: TPascalClassSections;
5746   ListOfPCodeXYPosition: TFPList; out AllEmpty: boolean): boolean;
5747 var
5748   ProcBodyNodes: TAVLTree;
5749   AVLNode: TAVLTreeNode;
5750   NodeExt: TCodeTreeNodeExtension;
5751   Caret: TCodeXYPosition;
5752   CaretP: PCodeXYPosition;
5753 begin
5754   Result:=false;
5755   ProcBodyNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
5756   try
5757     Result:=FindEmptyMethods(CursorPos,AClassName,Sections,ProcBodyNodes,AllEmpty);
5758     if Result then begin
5759       AVLNode:=ProcBodyNodes.FindLowest;
5760       while AVLNode<>nil do begin
5761         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5762         if CleanPosToCaret(NodeExt.Node.StartPos,Caret) then begin
5763           New(CaretP);
5764           CaretP^:=Caret;
5765           ListOfPCodeXYPosition.Add(CaretP);
5766         end;
5767         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5768       end;
5769     end;
5770   finally
5771     DisposeAVLTree(ProcBodyNodes);
5772   end;
5773 end;
5774 
FindEmptyMethodsnull5775 function TCodeCompletionCodeTool.FindEmptyMethods(CursorPos: TCodeXYPosition;
5776   const AClassName: string; const Sections: TPascalClassSections;
5777   CodeTreeNodeExtensions: TAVLTree;
5778   out AllEmpty: boolean): boolean;
5779 // NodeExt.Node is the body node
5780 // NodeExt.Data is the definition node
5781 var
5782   CleanCursorPos: integer;
5783   CursorNode: TCodeTreeNode;
5784   TypeSectionNode: TCodeTreeNode;
5785   ProcBodyNodes, ClassProcs: TAVLTree;
5786   AVLNode: TAVLTreeNode;
5787   NodeExt: TCodeTreeNodeExtension;
5788   NextAVLNode: TAVLTreeNode;
5789   DefAVLNode: TAVLTreeNode;
5790   DefNodeExt: TCodeTreeNodeExtension;
5791   Desc: TCodeTreeNodeDesc;
5792   Fits: Boolean;
5793   s: TPascalClassSection;
5794 
5795   procedure GatherClassProcs;
5796   begin
5797     // gather existing proc definitions in the class
5798     if ClassProcs=nil then begin
5799       ClassProcs:=GatherProcNodes(FCompletingFirstEntryNode,
5800          [phpInUpperCase,phpAddClassName],
5801          ExtractClassName(CodeCompleteClassNode,true));
5802     end;
5803   end;
5804 
5805 begin
5806   Result:=false;
5807   AllEmpty:=false;
5808   if (AClassName<>'') and (CursorPos.Y<1) then begin
5809     BuildTree(lsrInitializationStart);
5810     CursorNode:=FindClassNodeInInterface(AClassName,true,false,true);
5811     CodeCompleteClassNode:=CursorNode;
5812   end else begin
5813     BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
5814     CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
5815     CodeCompleteClassNode:=FindClassNode(CursorNode);
5816   end;
5817   if CodeCompleteClassNode=nil then begin
5818     DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods no class at ',Dbgs(CursorPos)]);
5819     exit;
5820   end;
5821   ProcBodyNodes:=nil;
5822   ClassProcs:=nil;
5823   try
5824     // gather body nodes
5825     TypeSectionNode:=CodeCompleteClassNode.GetTopMostNodeOfType(ctnTypeSection);
5826     ProcBodyNodes:=GatherProcNodes(TypeSectionNode,
5827                         [phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
5828                          ExtractClassName(CodeCompleteClassNode,true));
5829     // collect all empty bodies
5830     AVLNode:=ProcBodyNodes.FindLowest;
5831     while AVLNode<>nil do begin
5832       NextAVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5833       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5834       //DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods ',NodeExt.Txt,' ',ProcBodyIsEmpty(NodeExt.Node)]);
5835       // check if proc body is empty (no code, no comments)
5836       if ProcBodyIsEmpty(NodeExt.Node) then begin
5837         GatherClassProcs;
5838         // search the corresponding node in the class
5839         DefAVLNode:=ClassProcs.Find(NodeExt);
5840         if (DefAVLNode<>nil) then begin
5841           DefNodeExt:=TCodeTreeNodeExtension(DefAVLNode.Data);
5842           // check visibility section
5843           if (DefNodeExt.Node.Parent<>nil) then begin
5844             Desc:=DefNodeExt.Node.Parent.Desc;
5845             Fits:=false;
5846             for s:=Low(TPascalClassSection) to High(TPascalClassSection) do
5847               if (s in Sections) and (PascalClassSectionToNodeDesc[s]=Desc) then
5848                 Fits:=true;
5849             if Fits then begin
5850               // empty and right section => add to tree
5851               ProcBodyNodes.Delete(AVLNode);
5852               NodeExt.Data:=DefNodeExt.Node;
5853               CodeTreeNodeExtensions.Add(NodeExt);
5854             end;
5855           end;
5856         end;
5857       end;
5858       AVLNode:=NextAVLNode;
5859     end;
5860     AllEmpty:=ProcBodyNodes.Count=0;
5861     Result:=true;
5862   finally
5863     DisposeAVLTree(ClassProcs);
5864     DisposeAVLTree(ProcBodyNodes);
5865   end;
5866 end;
5867 
RemoveEmptyMethodsnull5868 function TCodeCompletionCodeTool.RemoveEmptyMethods(CursorPos: TCodeXYPosition;
5869   const AClassName: string; const Sections: TPascalClassSections;
5870   SourceChangeCache: TSourceChangeCache;
5871   out AllRemoved: boolean;
5872   const Attr: TProcHeadAttributes; out RemovedProcHeads: TStrings): boolean;
5873 var
5874   ProcBodyNodes: TAVLTree;
5875   AVLNode: TAVLTreeNode;
5876   NodeExt: TCodeTreeNodeExtension;
5877   FirstNodeExt: TCodeTreeNodeExtension;
5878   LastNodeExt: TCodeTreeNodeExtension;
5879   FromPos: LongInt;
5880   ToPos: LongInt;
5881   FirstGroup: Boolean;
5882   CommentEndPos: integer;
5883   CommentStartPos: integer;
5884   ProcDefNodes: TAVLTree;
5885   NextAVLNode: TAVLTreeNode;
5886   ProcHead: String;
5887 begin
5888   Result:=false;
5889   AllRemoved:=false;
5890   RemovedProcHeads:=nil;
5891   if (SourceChangeCache=nil) or (Scanner=nil) then exit;
5892   SourceChangeCache.MainScanner:=Scanner;
5893   ProcDefNodes:=nil;
5894   ProcBodyNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
5895   try
5896     Result:=FindEmptyMethods(CursorPos,AClassName,Sections,ProcBodyNodes,AllRemoved);
5897     if Result and (ProcBodyNodes<>nil) and (ProcBodyNodes.Count>0) then begin
5898       // sort the nodes for position
5899       ProcBodyNodes.OnCompare:=@CompareCodeTreeNodeExtWithPos;
5900       ProcDefNodes:=TAVLTree.Create(@CompareCodeTreeNodeExtWithPos);
5901 
5902       // delete bodies
5903       AVLNode:=ProcBodyNodes.FindLowest;
5904       FirstGroup:=true;
5905       while AVLNode<>nil do begin
5906         // gather a group of continuous proc nodes
5907         FirstNodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5908         LastNodeExt:=FirstNodeExt;
5909         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5910         while (AVLNode<>nil) do begin
5911           NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5912           if NodeExt.Node<>LastNodeExt.Node.NextBrother then break;
5913           LastNodeExt:=NodeExt;
5914           AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5915         end;
5916         // delete group
5917         FromPos:=FindLineEndOrCodeInFrontOfPosition(FirstNodeExt.Node.StartPos,true);
5918         ToPos:=FindLineEndOrCodeAfterPosition(LastNodeExt.Node.EndPos,true);
5919         {$IFDEF VerboseBug16168}
5920         debugln(['TCodeCompletionCodeTool.RemoveEmptyMethods ',dbgstr(copy(Src,FromPos,ToPos-FromPos))]);
5921         {$ENDIF}
5922         if AllRemoved and FirstGroup
5923         and FindClassMethodsComment(FromPos,CommentStartPos,CommentEndPos) then begin
5924           // all method bodies will be removed => remove the default comment too
5925           if FindNextNonSpace(Src,CommentEndPos)>=FromPos then begin
5926             // the default comment is directly in front
5927             // => remove it too
5928             FromPos:=FindLineEndOrCodeInFrontOfPosition(CommentStartPos,true);
5929           end;
5930         end;
5931         if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then
5932           exit;
5933         FirstGroup:=false;
5934       end;
5935 
5936       // create the tree of proc definitions: ProcDefNodes
5937       AVLNode:=ProcBodyNodes.FindLowest;
5938       while AVLNode<>nil do begin
5939         NextAVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5940         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5941         // remove NodeExt from ProcBodyNodes
5942         ProcBodyNodes.Delete(AVLNode);
5943         // and add it to ProcDefNodes
5944         // the definition node is the Data
5945         // Note: the class can contain errors and therefore some method bodies
5946         // refer to the same definition => skip doubles
5947         NodeExt.Node:=TCodeTreeNode(NodeExt.Data);
5948         NodeExt.Position:=NodeExt.Node.StartPos;
5949         if (NodeExt.Node<>nil) and (ProcDefNodes.Find(NodeExt)=nil) then begin
5950           ProcDefNodes.Add(NodeExt);
5951           if RemovedProcHeads=nil then
5952             RemovedProcHeads:=TStringList.Create;
5953           ProcHead:=ExtractProcHead(NodeExt.Node,Attr);
5954           RemovedProcHeads.Add(ProcHead);
5955         end else begin
5956           NodeExt.Free;
5957         end;
5958         AVLNode:=NextAVLNode;
5959       end;
5960 
5961       // delete definitions
5962       AVLNode:=ProcDefNodes.FindLowest;
5963       while AVLNode<>nil do begin
5964         // gather a group of continuous proc nodes
5965         FirstNodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5966         LastNodeExt:=FirstNodeExt;
5967         AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5968         while (AVLNode<>nil) do begin
5969           NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
5970           if NodeExt.Node<>LastNodeExt.Node.NextBrother then break;
5971           LastNodeExt:=NodeExt;
5972           AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
5973         end;
5974         // delete group
5975         FromPos:=FindLineEndOrCodeInFrontOfPosition(FirstNodeExt.Node.StartPos,true);
5976         ToPos:=FindLineEndOrCodeAfterPosition(LastNodeExt.Node.EndPos,true);
5977         if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then
5978           exit;
5979       end;
5980     end;
5981     Result:=SourceChangeCache.Apply;
5982   finally
5983     DisposeAVLTree(ProcBodyNodes);
5984     DisposeAVLTree(ProcDefNodes);
5985   end;
5986 end;
5987 
FindAssignMethodnull5988 function TCodeCompletionCodeTool.FindAssignMethod(CursorPos: TCodeXYPosition;
5989   out ClassNode: TCodeTreeNode; out AssignDeclNode: TCodeTreeNode;
5990   var MemberNodeExts: TAVLTree; out AssignBodyNode: TCodeTreeNode;
5991   out InheritedDeclContext: TFindContext;
5992   ProcName: string): boolean;
5993 { if CursorPos is in a class declaration search for a method "Assign"
5994   and its corresponding body.
5995   If CursorPos is in a method body use this as a Assign method and return
5996   its corresponding declararion.
5997   If neither return false.
5998   Also return a tree of all variables and properties (excluding ancestors).
5999 }
6000 
6001   procedure SearchAssign(Tool: TFindDeclarationTool; Node: TCodeTreeNode;
6002     var DeclNode: TCodeTreeNode);
6003   var
6004     Child: TCodeTreeNode;
6005     CurProcName: String;
6006   begin
6007     if Node=nil then exit;
6008     Child:=Node.FirstChild;
6009     while Child<>nil do begin
6010       if Child.Desc in AllClassSections then
6011         SearchAssign(Tool,Child,DeclNode)
6012       else if Child.Desc=ctnProcedure then begin
6013         CurProcName:=Tool.ExtractProcName(Child,[]);
6014         if CompareIdentifiers(PChar(CurProcName),PChar(ProcName))=0 then begin
6015           if DeclNode<>nil then begin
6016             debugln(['WARNING: TCodeCompletionCodeTool.FindAssignMethod.SearchAssign'
6017               +' multiple ',ProcName,' methods found, using the first at ',CleanPosToStr(DeclNode.StartPos)]);
6018           end else
6019             DeclNode:=Child;
6020         end;
6021       end;
6022       Child:=Child.NextBrother;
6023     end;
6024   end;
6025 
6026   procedure GatherAssignableMembers(Node: TCodeTreeNode);
6027   var
6028     Child: TCodeTreeNode;
6029     NodeExt: TCodeTreeNodeExtension;
6030   begin
6031     if Node=nil then exit;
6032     Child:=Node.FirstChild;
6033     while Child<>nil do begin
6034       if Child.Desc in AllClassSections then
6035         GatherAssignableMembers(Child)
6036       else if (Child.Desc=ctnVarDefinition)
6037       or ((Child.Desc=ctnProperty)
6038         and (PropertyHasSpecifier(Child,'read'))
6039         and (PropertyHasSpecifier(Child,'write')))
6040       then begin
6041         // a variable or a property which is readable and writable
6042         if MemberNodeExts=nil then
6043           MemberNodeExts:=TAVLTree.Create(@CompareCodeTreeNodeExtTxtAndPos);
6044         NodeExt:=TCodeTreeNodeExtension.Create;
6045         NodeExt.Node:=Child;
6046         NodeExt.Position:=Child.StartPos;
6047         if Child.Desc=ctnVarDefinition then
6048           NodeExt.Txt:=ExtractDefinitionName(Child)
6049         else
6050           NodeExt.Txt:=ExtractPropName(Child,false);
6051         MemberNodeExts.Add(NodeExt);
6052       end;
6053 
6054       Child:=Child.NextBrother;
6055     end;
6056   end;
6057 
6058   procedure FindVarsWrittenByProperties;
6059   var
6060     AVLNode: TAVLTreeNode;
6061     NodeExt: TCodeTreeNodeExtension;
6062     WrittenNodeExt: TCodeTreeNodeExtension;
6063   begin
6064     if MemberNodeExts=nil then exit;
6065     AVLNode:=MemberNodeExts.FindLowest;
6066     while AVLNode<>nil do begin
6067       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
6068       if NodeExt.Node.Desc=ctnProperty then begin
6069         if PropertyHasSpecifier(NodeExt.Node,'write') then begin
6070           ReadNextAtom;
6071           if AtomIsIdentifier then begin
6072             WrittenNodeExt:=FindCodeTreeNodeExtWithIdentifier(MemberNodeExts,
6073                                       @Src[CurPos.StartPos]);
6074             if WrittenNodeExt<>nil then
6075               WrittenNodeExt.Data:=NodeExt.Node;
6076           end;
6077         end;
6078       end;
6079       AVLNode:=MemberNodeExts.FindSuccessor(AVLNode);
6080     end;
6081   end;
6082 
6083   procedure FindInheritedAssign;
6084   var
6085     Params: TFindDeclarationParams;
6086   begin
6087     if ClassNode=nil then exit;
6088     Params:=TFindDeclarationParams.Create(Self, ClassNode);
6089     try
6090       Params.Flags:=[fdfSearchInAncestors];
6091       Params.Identifier:=PChar(ProcName);
6092       if not FindIdentifierInContext(Params) then exit;
6093       //debugln(['FindInheritedAssign NewNode=',Params.NewNode.DescAsString]);
6094       if Params.NewNode=nil then exit;
6095       if Params.NewNode.Desc<>ctnProcedure then exit;
6096       InheritedDeclContext:=CreateFindContext(Params);
6097     finally
6098       Params.Free;
6099     end;
6100   end;
6101 
6102 var
6103   CleanPos: integer;
6104   CursorNode: TCodeTreeNode;
6105   Node: TCodeTreeNode;
6106 begin
6107   Result:=false;
6108   ClassNode:=nil;
6109   AssignDeclNode:=nil;
6110   AssignBodyNode:=nil;
6111   InheritedDeclContext:=CleanFindContext;
6112   BuildTreeAndGetCleanPos(CursorPos,CleanPos);
6113   if ProcName='' then ProcName:='Assign';
6114   // check context
6115   CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
6116   Node:=CursorNode;
6117   while (Node<>nil) do begin
6118     if (Node.Desc=ctnProcedure) then begin
6119       if NodeIsMethodBody(Node) then begin
6120         // cursor in method body
6121         AssignBodyNode:=Node;
6122         Result:=true;
6123         AssignDeclNode:=FindCorrespondingProcNode(AssignBodyNode);
6124         if AssignDeclNode<>nil then
6125           ClassNode:=FindClassOrInterfaceNode(AssignDeclNode.Parent);
6126         break;
6127       end;
6128     end else if (Node.Desc in AllClassObjects) then begin
6129       // cursor in class/record
6130       Result:=true;
6131       ClassNode:=Node;
6132       SearchAssign(Self,ClassNode,AssignDeclNode);
6133       if AssignDeclNode<>nil then
6134         AssignBodyNode:=FindCorrespondingProcNode(AssignDeclNode);
6135       break;
6136     end;
6137     Node:=Node.Parent;
6138   end;
6139   if ClassNode=nil then exit;
6140   GatherAssignableMembers(ClassNode);
6141   FindVarsWrittenByProperties;
6142   FindInheritedAssign;
6143 end;
6144 
AddAssignMethodnull6145 function TCodeCompletionCodeTool.AddAssignMethod(ClassNode: TCodeTreeNode;
6146   MemberNodeExts: TFPList; const ProcName, ParamName, ParamType: string;
6147   OverrideMod, CallInherited, CallInheritedOnlyInElse: boolean;
6148   SourceChanger: TSourceChangeCache; out NewPos: TCodeXYPosition; out
6149   NewTopLine, BlockTopLine, BlockBottomLine: integer; LocalVarName: string
6150   ): boolean;
6151 var
6152   NodeExt: TCodeTreeNodeExtension;
6153   CleanDef: String;
6154   Def: String;
6155   aClassName: String;
6156   ProcBody: String;
6157   e: String;
6158   SameType: boolean;
6159   Indent: Integer;
6160   IndentStep: LongInt;
6161   SrcVar: String;
6162   i: Integer;
6163   Beauty: TBeautifyCodeOptions;
6164   {$IFDEF EnableCodeCompleteTemplates}
6165   NodeExtsStr: String;
6166   {$ENDIF}
6167 begin
6168   Result:=false;
6169   NewPos:=CleanCodeXYPosition;
6170   NewTopLine:=-1;
6171   if ClassNode=nil then exit;
6172   if (ParamName='') or (ParamType='') then exit;
6173   Beauty:=SourceChanger.BeautifyCodeOptions;
6174   aClassName:=ExtractClassName(ClassNode,false);
6175   CleanDef:=ProcName+'('+ParamType+');';
6176   {$IFDEF EnableCodeCompleteTemplates}
6177   if assigned(CTTemplateExpander)
6178   and CTTemplateExpander.TemplateExists('AssignMethodDef') then
6179   begin
6180     Def := CTTemplateExpander.Expand('AssignMethodDef', '','', // Doesn't use linebreak or indentation
6181                      ['ProcName',  'ParamName',  'ParamType', 'Override' ],
6182                      [ ProcName,    ParamName,    ParamType,   OverrideMod ] );
6183   end else
6184   {$ENDIF EnableCodeCompleteTemplates}
6185   begin
6186     Def:='procedure '+ProcName+'('+ParamName+':'+ParamType+');';
6187     if OverrideMod then Def:=Def+'override;';
6188   end;
6189   SrcVar:=ParamName;
6190   // create the proc header
6191   SameType:=CompareIdentifiers(PChar(aClassName),PChar(ParamType))=0;
6192   e:=SourceChanger.BeautifyCodeOptions.LineEnd;
6193   Indent:=0;
6194   IndentStep:=SourceChanger.BeautifyCodeOptions.Indent;
6195   {$IFDEF EnableCodeCompleteTemplates}
6196   if assigned(CTTemplateExpander)
6197   and CTTemplateExpander.TemplateExists('AssignMethod') then begin
6198     if not SameType then begin
6199       // add local variable
6200       SrcVar:=LocalVarName;
6201       if SrcVar='' then
6202         SrcVar:='aSource';
6203       if CompareIdentifiers(PChar(SrcVar),PChar(ParamName))=0 then begin
6204         if CompareIdentifiers(PChar(SrcVar),'aSource')=0 then
6205           SrcVar:='aSrc'
6206         else
6207           SrcVar:='aSource';
6208         end;
6209       end;
6210       // add assignments
6211       NodeExtsStr := '';
6212      if MemberNodeExts<>nil then begin
6213        for i:=0 to MemberNodeExts.Count-1 do
6214        begin
6215          NodeExt:=TCodeTreeNodeExtension(MemberNodeExts[i]);
6216          NodeExtsStr := NodeExtsStr + NodeExt.Txt + '?';
6217        end;
6218      end;
6219      ProcBody := CTTemplateExpander.Expand( 'AssignMethod',e,GetIndentStr(Indent),
6220                    ['ClassName', 'ProcName', 'ParamName',  'ParamType',
6221                      'SameType',  'SrcVar',   'Inherited0', 'Inherited1',
6222                      'NodeExt' ],
6223                     [ aClassName,  ProcName,   ParamName,    ParamType,
6224                       SameType,    SrcVar,
6225                       CallInherited and (not CallInheritedOnlyInElse),
6226                       CallInherited and CallInheritedOnlyInElse,
6227                       NodeExtsStr ] );
6228     end
6229   else
6230   {$ENDIF EnableCodeCompleteTemplates}
6231   begin
6232     ProcBody:='procedure '+aClassName+'.'+ProcName+'('+ParamName+':'+ParamType+');'+e;
6233     if not SameType then begin
6234       // add local variable
6235       SrcVar:=LocalVarName;
6236       if SrcVar='' then
6237         SrcVar:='aSource';
6238       if CompareIdentifiers(PChar(SrcVar),PChar(ParamName))=0 then begin
6239         if CompareIdentifiers(PChar(SrcVar),'aSource')=0 then
6240           SrcVar:='aSrc'
6241         else
6242           SrcVar:='aSource';
6243       end;
6244       ProcBody:=ProcBody+'var'+e
6245          +Beauty.GetIndentStr(Indent+IndentStep)+SrcVar+':'+aClassName+';'+e;
6246     end;
6247     ProcBody:=ProcBody+'begin'+e;
6248     inc(Indent,IndentStep);
6249 
6250     // call inherited
6251     if CallInherited and (not CallInheritedOnlyInElse) then
6252       ProcBody:=ProcBody
6253         +Beauty.GetIndentStr(Indent)+'inherited '+ProcName+'('+ParamName+');'+e;
6254 
6255     if not SameType then begin
6256       // add a parameter check to the new procedure
6257       ProcBody:=ProcBody
6258           +Beauty.GetIndentStr(Indent)+'if '+ParamName+' is '+aClassName+' then'+e
6259           +Beauty.GetIndentStr(Indent)+'begin'+e;
6260       inc(Indent,IndentStep);
6261       ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+SrcVar+':='+aClassName+'('+ParamName+');'+e;
6262     end;
6263 
6264     // add assignments
6265     if MemberNodeExts<>nil then begin
6266       for i:=0 to MemberNodeExts.Count-1 do begin
6267         NodeExt:=TCodeTreeNodeExtension(MemberNodeExts[i]);
6268         // add assignment
6269         ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+NodeExt.Txt+':='+SrcVar+'.'+NodeExt.Txt+';'+e;
6270       end;
6271     end;
6272 
6273     if not SameType then begin
6274       // close if block
6275       dec(Indent,IndentStep);
6276       if CallInherited and CallInheritedOnlyInElse then begin
6277         ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+'end else'+e
6278             +Beauty.GetIndentStr(Indent+IndentStep)+'inherited '+ProcName+'('+ParamName+');'+e;
6279       end else begin
6280         ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+'end;'+e
6281       end;
6282     end;
6283     // close procedure body
6284     ProcBody:=ProcBody+'end;';
6285   end;
6286 
6287   if not InitClassCompletion(ClassNode,SourceChanger) then exit;
6288   ProcBody:=SourceChanger.BeautifyCodeOptions.BeautifyStatement(ProcBody,0);
6289   AddClassInsertion(CleanDef,Def,ProcName,ncpPublicProcs,nil,ProcBody);
6290   Result:=ApplyChangesAndJumpToFirstNewProc(ClassNode.StartPos,1,true,
6291                    NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
6292 end;
6293 
TCodeCompletionCodeTool.AddAssignMethodnull6294 function TCodeCompletionCodeTool.AddAssignMethod(ClassNode: TCodeTreeNode;
6295   MemberNodeExts: TFPList; const ProcName, ParamName, ParamType: string;
6296   OverrideMod, CallInherited, CallInheritedOnlyInElse: boolean;
6297   SourceChanger: TSourceChangeCache; out NewPos: TCodeXYPosition; out
6298   NewTopLine: integer; LocalVarName: string): boolean;
6299 var
6300   BlockTopLine, BlockBottomLine: integer;
6301 begin
6302   Result := AddAssignMethod(ClassNode, MemberNodeExts, ProcName, ParamName, ParamType,
6303     OverrideMod, CallInherited, CallInheritedOnlyInElse, SourceChanger, NewPos, NewTopLine,
6304     BlockTopLine, BlockBottomLine, LocalVarName);
6305 end;
6306 
TCodeCompletionCodeTool.GetPossibleInitsForVariablenull6307 function TCodeCompletionCodeTool.GetPossibleInitsForVariable(
6308   CursorPos: TCodeXYPosition; out Statements: TStrings; out
6309   InsertPositions: TObjectList; SourceChangeCache: TSourceChangeCache): boolean;
6310 var
6311   Identifier: PChar;
6312 
6313   procedure AddStatement(aStatement: string);
6314   begin
6315     if SourceChangeCache<>nil then begin
6316       SourceChangeCache.MainScanner:=Scanner;
6317       SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(aStatement,0);
6318     end;
6319     {$IFDEF VerboseGetPossibleInitsForVariable}
6320     debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable.AddStatement "',aStatement,'"']);
6321     {$ENDIF}
6322     Statements.Add(aStatement);
6323   end;
6324 
6325   procedure AddAssignment(const aValue: string);
6326   begin
6327     AddStatement(GetIdentifier(Identifier)+':='+aValue+';');
6328   end;
6329 
6330 var
6331   CleanCursorPos: integer;
6332   CursorNode: TCodeTreeNode;
6333   IdentAtom: TAtomPosition;
6334   Params: TFindDeclarationParams;
6335   VarTool: TFindDeclarationTool;
6336   VarNode: TCodeTreeNode;
6337   ExprType: TExpressionType;
6338   BeginNode: TCodeTreeNode;
6339   InsertPosDesc: TInsertStatementPosDescription;
6340   Node: TCodeTreeNode;
6341   Tool: TFindDeclarationTool;
6342   aContext: TFindContext;
6343   FuncNode: TCodeTreeNode;
6344 begin
6345   {$IFDEF VerboseGetPossibleInitsForVariable}
6346   debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable ',dbgs(CursorPos)]);
6347   {$ENDIF}
6348   Result:=false;
6349   Statements:=TStringList.Create;
6350   InsertPositions:=TObjectList.create(true);
6351   BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
6352 
6353   // find variable name
6354   GetIdentStartEndAtPosition(Src,CleanCursorPos,
6355     IdentAtom.StartPos,IdentAtom.EndPos);
6356   {$IFDEF VerboseGetPossibleInitsForVariable}
6357   debugln('TCodeCompletionCodeTool.GetPossibleInitsForLocalVar IdentAtom="',dbgstr(Src,IdentAtom.StartPos,IdentAtom.EndPos-IdentAtom.StartPos),'"');
6358   {$ENDIF}
6359   if IdentAtom.StartPos=IdentAtom.EndPos then exit;
6360 
6361   // find context
6362   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6363 
6364   // find declaration of identifier
6365   VarTool:=nil;
6366   VarNode:=nil;
6367   Identifier:=@Src[IdentAtom.StartPos];
6368   if (cmsResult in FLastCompilerModeSwitches)
6369   and (CompareIdentifiers(Identifier,'Result')=0) then begin
6370     FuncNode:=CursorNode;
uncNodenull6371     while not NodeIsFunction(FuncNode) do
6372       FuncNode:=FuncNode.Parent;
6373     VarTool:=Self;
6374     VarNode:=FuncNode;
6375     Result:=true;
6376   end;
6377   if VarNode=nil then begin
6378     Params:=TFindDeclarationParams.Create(Self, CursorNode);
6379     try
6380       Params.SetIdentifier(Self,Identifier,nil);
6381       Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
6382                      fdfTopLvlResolving,fdfFindVariable];
6383       Result:=FindIdentifierInContext(Params);
6384       VarTool:=Params.NewCodeTool;
6385       VarNode:=Params.NewNode;
6386       if (not Result) or (VarNode=nil) then begin
6387         {$IFDEF VerboseGetPossibleInitsForVariable}
6388         debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable FindIdentifierInContext Result=',Result,' VarTool=',VarTool<>nil,' VarNode=',VarNode<>nil]);
6389         {$ENDIF}
6390         MoveCursorToAtomPos(IdentAtom);
6391         RaiseException(20170421201708,'failed to resolve identifier "'+Identifier+'"');
6392       end;
6393       {$IFDEF VerboseGetPossibleInitsForVariable}
6394       debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable FindIdentifierInContext VarTool=',ExtractFilename(VarTool.MainFilename),' VarNode=',VarNode.DescAsString]);
6395       {$ENDIF}
6396     finally
6397       Params.Free;
6398     end;
6399   end;
6400 
6401   // resolve type
6402   Params:=TFindDeclarationParams.Create(Self, CursorNode);
6403   try
6404     Params.Flags:=fdfDefaultForExpressions;
6405     if VarNode.Desc in [ctnProcedure,ctnProcedureHead] then
6406       Params.Flags:=Params.Flags+[fdfFunctionResult];
6407     ExprType:=VarTool.ConvertNodeToExpressionType(VarNode,Params);
6408     {$IFDEF VerboseGetPossibleInitsForVariable}
6409     DebugLn('TCodeCompletionCodeTool.GetPossibleInitsForVariable ConvertNodeToExpressionType',
6410       ' Expr=',ExprTypeToString(ExprType));
6411     {$ENDIF}
6412   finally
6413     Params.Free;
6414   end;
6415 
6416   case ExprType.Desc of
6417   xtContext:
6418     begin
6419       // ToDo: ranges, records, objects, pointer, class, class of, interface
6420       Node:=ExprType.Context.Node;
6421       Tool:=ExprType.Context.Tool;
6422       case Node.Desc of
6423       ctnEnumerationType:
6424         begin
6425           // enumeration: add first 10 enums
6426           Node:=Node.FirstChild;
6427           while (Node<>nil) and (Statements.Count<10) do begin
6428             if Node.Desc=ctnEnumIdentifier then
6429               AddAssignment(GetIdentifier(@Tool.Src[Node.StartPos]));
6430             Node:=Node.NextBrother;
6431           end;
6432         end;
6433       ctnSetType:
6434         // set of
6435         AddAssignment('[]');
6436       ctnClass,ctnClassInterface,ctnDispinterface,
6437       ctnObjCClass,ctnObjCCategory,ctnObjCProtocol,ctnCPPClass:
6438         AddAssignment('nil');
6439       ctnPointerType:
6440         AddAssignment('nil');
6441       ctnProcedureType,ctnReferenceTo:
6442         // address of proc
6443         AddAssignment('nil');
6444       ctnProcedureHead:
odenull6445         if Tool.NodeIsFunction(Node) then begin
6446           Params:=TFindDeclarationParams.Create(Tool, Node);
6447           try
6448             aContext:=Tool.FindBaseTypeOfNode(Params,Node);
6449             Tool:=aContext.Tool;
6450             Node:=aContext.Node;
6451           finally
6452             Params.Free;
6453           end;
6454         end;
6455       end;
6456     end;
6457   xtChar,
6458   xtWideChar: begin AddAssignment('#0'); AddAssignment(''' '''); end;
6459   xtReal,
6460   xtSingle,
6461   xtDouble,
6462   xtExtended,
6463   xtCExtended: begin AddAssignment('0.0'); AddAssignment('1.0'); end;
6464   xtCurrency: AddAssignment('0.00');
6465   xtComp,
6466   xtInt64,
6467   xtCardinal,
6468   xtQWord: AddAssignment('0');
6469   xtBoolean,
6470   xtByteBool,
6471   xtWordBool,
6472   xtLongBool,
6473   xtQWordBool: begin AddAssignment('False'); AddAssignment('True'); end;
6474   xtString,
6475   xtAnsiString,
6476   xtShortString,
6477   xtWideString,
6478   xtUnicodeString: AddAssignment('''''');
6479   xtPChar: begin AddAssignment('nil'); AddAssignment('#0'); end;
6480   xtPointer: AddAssignment('nil');
6481   xtConstOrdInteger: AddAssignment('0');
6482   xtConstString: AddAssignment('''''');
6483   xtConstReal: AddAssignment('0.0');
6484   xtConstSet: AddAssignment('[]');
6485   xtConstBoolean: begin AddAssignment('False'); AddAssignment('True'); end;
6486   xtLongint,
6487   xtLongWord,
6488   xtWord,
6489   xtSmallInt,
6490   xtShortInt,
6491   xtByte,
6492   xtNativeInt,
6493   xtNativeUInt: AddAssignment('0');
6494   xtVariant: begin AddAssignment('0'); AddAssignment(''''''); end;
6495   xtJSValue: begin AddAssignment('0'); AddAssignment(''''''); AddAssignment('nil'); AddAssignment('false'); end;
6496   end;
6497   if Statements.Count=0 then begin
6498     MoveCursorToAtomPos(IdentAtom);
6499     RaiseException(20170421201711,'auto initialize not yet implemented for identifier "'+GetIdentifier(Identifier)+'" of type "'+ExprTypeToString(ExprType)+'"');
6500   end;
6501 
6502   // find possible insert positions
6503   BeginNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
6504   if BeginNode<>nil then begin
6505     InsertPosDesc:=TInsertStatementPosDescription.Create;
6506     InsertPosDesc.InsertPos:=BeginNode.StartPos+length('begin');
6507     CleanPosToCaret(InsertPosDesc.InsertPos,InsertPosDesc.CodeXYPos);
6508     InsertPosDesc.Indent:=GetLineIndent(Src,BeginNode.StartPos);
6509     if SourceChangeCache<>nil then
6510       inc(InsertPosDesc.Indent,SourceChangeCache.BeautifyCodeOptions.Indent)
6511     else
6512       inc(InsertPosDesc.Indent,2);
6513     InsertPosDesc.FrontGap:=gtNewLine;
6514     InsertPosDesc.AfterGap:=gtNewLine;
6515     InsertPosDesc.Description:='After BEGIN keyword';
6516     if (BeginNode.Parent<>nil) then begin
6517       if BeginNode.Parent.Desc=ctnProcedure then
6518         InsertPosDesc.Description+=' of '
6519           +ExtractProcHead(BeginNode.Parent,[phpWithStart,phpAddClassName,phpWithoutParamList]);
6520     end;
6521     InsertPositions.Add(InsertPosDesc);
6522   end;
6523 
6524   if InsertPositions.Count=0 then begin
6525     MoveCursorToAtomPos(IdentAtom);
6526     RaiseException(20170421201714,'auto initialize not yet implemented for this context (Node='+CursorNode.DescAsString+')');
6527   end;
6528 end;
6529 
GuessTypeOfIdentifiernull6530 function TCodeCompletionCodeTool.GuessTypeOfIdentifier(
6531   CursorPos: TCodeXYPosition; out IsKeyword, IsSubIdentifier: boolean;
6532   out ExistingDefinition: TFindContext; out ListOfPFindContext: TFPList;
6533   out NewExprType: TExpressionType; out NewType: string): boolean;
6534 { examples:
6535    identifier:=<something>
6536    aclass.identifier:=<something>
6537    <something>:=aclass.identifier
6538    <something>:=<something>+aclass.identifier
6539    for identifier in <something>
6540    ToDo: <proc>(,,aclass.identifier)
6541 
6542  checks where the identifier is already defined or is a keyword
6543  checks if the identifier is a sub identifier (e.g. A.identifier)
6544  creates the list of possible insert locations
6545  checks if it is the target of an assignment and guesses the type
6546  checks if it is the run variable of an for in and guesses the type
6547  ToDo: checks if it is a parameter and guesses the type
6548 }
6549 var
6550   CleanCursorPos: integer;
6551   Params: TFindDeclarationParams;
6552   CursorNode: TCodeTreeNode;
6553   IdentifierAtom: TAtomPosition;
6554   TermAtom: TAtomPosition;
6555   i: Integer;
6556   Context: PFindContext;
6557   Section: TCodeTreeNode;
6558   ExistingNodeInProc: Boolean;
6559   Keep: Boolean;
6560   InAtomEndPos: Integer;
6561 begin
6562   Result:=false;
6563   IsKeyword:=false;
6564   IsSubIdentifier:=false;
6565   ExistingDefinition:=CleanFindContext;
6566   ListOfPFindContext:=nil;
6567   NewExprType:=CleanExpressionType;
6568   NewType:='';
6569   BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
6570   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6571 
6572   // find identifier name
6573   GetIdentStartEndAtPosition(Src,CleanCursorPos,
6574     IdentifierAtom.StartPos,IdentifierAtom.EndPos);
6575   {$IFDEF VerboseGuessTypeOfIdentifier}
6576   debugln('TCodeCompletionCodeTool.GuessTypeOfIdentifier A Atom=',GetAtom(IdentifierAtom),' "',dbgstr(Src,CleanCursorPos,10),'"');
6577   {$ENDIF}
6578   if IdentifierAtom.StartPos=IdentifierAtom.EndPos then exit;
6579   Result:=true;
6580 
6581   MoveCursorToAtomPos(IdentifierAtom);
6582   if AtomIsKeyWord then begin
6583     {$IFDEF VerboseGuessTypeOfIdentifier}
6584     debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier is keyword: ',GetAtom]);
6585     {$ENDIF}
6586     IsKeyword:=true;
6587     exit;
6588   end;
6589 
6590   // search identifier
6591   ActivateGlobalWriteLock;
6592   try
6593     Params:=TFindDeclarationParams.Create(Self, CursorNode);
6594     try
6595       {$IF defined(CTDEBUG) or defined(VerboseGuessTypeOfIdentifier)}
6596       DebugLn('  GuessTypeOfIdentifier: check if variable is already defined ...');
6597       {$ENDIF}
6598       // check if identifier exists
6599       Result:=IdentifierIsDefined(IdentifierAtom,CursorNode,Params);
6600       if Result then begin
6601         // identifier is already defined
6602         ExistingDefinition.Tool:=Params.NewCodeTool;
6603         ExistingDefinition.Node:=Params.NewNode;
6604         {$IFDEF VerboseGuessTypeOfIdentifier}
6605         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier identifier already defined at ',FindContextToString(ExistingDefinition)]);
6606         {$ENDIF}
6607       end;
6608     finally
6609       Params.Free;
6610     end;
6611 
6612     // find all possible contexts
6613     if not FindIdentifierContextsAtStatement(IdentifierAtom.StartPos,
6614       IsSubIdentifier,ListOfPFindContext)
6615     then begin
6616       {$IFDEF VerboseGuessTypeOfIdentifier}
6617       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier FindIdentifierContextsAtStatement failed']);
6618       {$ENDIF}
6619       exit;
6620     end;
6621 
6622     // remove contexts conflicting with the already defined identifier
6623     if (ExistingDefinition.Node<>nil) and (ListOfPFindContext<>nil) then begin
6624       Section:=ExistingDefinition.Node;
6625       while Section<>nil do begin
6626         if Section.Desc in AllDefinitionSections then break;
6627         Section:=Section.Parent;
6628       end;
6629       ExistingNodeInProc:=ExistingDefinition.Node.HasParentOfType(ctnProcedure);
6630       if Section<>nil then begin
6631         for i:=ListOfPFindContext.Count-1 downto 0 do begin
6632           Context:=PFindContext(ListOfPFindContext[i]);
6633           Keep:=true;
6634           if ExistingNodeInProc then begin
6635             if (Context^.Tool<>ExistingDefinition.Tool)
6636             or (Context^.Node.StartPos<=ExistingDefinition.Node.StartPos) then
6637               Keep:=false; // existing is local var => delete all outside
6638           end;
6639 
6640           if Keep
6641           and (Context^.Tool=ExistingDefinition.Tool)
6642           and (((ExistingDefinition.Node=Context^.Node)
6643               or ExistingDefinition.Node.HasAsParent(Context^.Node)))
6644           then begin
6645             // context is outside or same as existing context
6646             // (e.g. identifier is already defined in the class) => delete
6647             Keep:=false;
6648           end;
6649           if Keep then continue;
6650           Dispose(Context);
6651           ListOfPFindContext.Delete(i);
6652         end;
6653       end;
6654     end;
6655 
6656     // find assignment operator :=
6657     MoveCursorToAtomPos(IdentifierAtom);
6658     ReadNextAtom;
6659     if AtomIs(':=') then begin
6660       // is assignment
6661       //AssignmentOperator:=CurPos;
6662 
6663       // find term
6664       ReadNextAtom;
6665       TermAtom.StartPos:=CurPos.StartPos;
6666       TermAtom.EndPos:=FindEndOfExpression(TermAtom.StartPos);
6667       if TermAtom.StartPos=TermAtom.EndPos then begin
6668         {$IFDEF VerboseGuessTypeOfIdentifier}
6669         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier nothing behind := operator']);
6670         {$ENDIF}
6671         exit;
6672       end;
6673       {$IFDEF VerboseGuessTypeOfIdentifier}
6674       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier guessing type of assignment :="',dbgstr(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"']);
6675       {$ENDIF}
6676 
6677       // find type of term
6678       Params:=TFindDeclarationParams.Create(Self, CursorNode);
6679       try
6680         NewType:=FindTermTypeAsString(TermAtom,Params,NewExprType);
6681       finally
6682         Params.Free;
6683       end;
6684       {$IFDEF VerboseGuessTypeOfIdentifier}
6685       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier Assignment type=',NewType]);
6686       {$ENDIF}
6687       Result:=true;
6688     end;
6689 
6690     if not Result then begin
6691       MoveCursorToAtomPos(IdentifierAtom);
6692       // find 'in' operator
6693       ReadNextAtom;
6694       if UpAtomIs('IN') then begin
6695         InAtomEndPos:=CurPos.EndPos;
6696 
6697         // find 'for' keyword
6698         MoveCursorToCleanPos(IdentifierAtom.StartPos);
6699         ReadPriorAtom;
6700         if not UpAtomIs('FOR') then exit;
6701 
6702         // find term
6703         MoveCursorToCleanPos(InAtomEndPos);
6704         ReadNextAtom;
6705         TermAtom.StartPos:=CurPos.StartPos;
6706         TermAtom.EndPos:=FindEndOfExpression(TermAtom.StartPos);
6707 
6708         {$IFDEF VerboseGuessTypeOfIdentifier}
6709         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier guessing type of for-in list "',dbgstr(Src,TermAtom.StartPos,TermAtom.EndPos-TermAtom.StartPos),'"']);
6710         {$ENDIF}
6711         // find type of term
6712         Params:=TFindDeclarationParams.Create(Self, CursorNode);
6713         try
6714           NewType:=FindForInTypeAsString(TermAtom,CursorNode,Params,NewExprType);
6715         finally
6716           Params.Free;
6717         end;
6718         {$IFDEF VerboseGuessTypeOfIdentifier}
6719         debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier For-In type=',NewType]);
6720         {$ENDIF}
6721         Result:=true;
6722       end;
6723     end;
6724 
6725     if not Result then begin
6726       {$IFDEF VerboseGuessTypeOfIdentifier}
6727       debugln(['TCodeCompletionCodeTool.GuessTypeOfIdentifier can not guess type']);
6728       {$ENDIF}
6729       exit;
6730     end;
6731 
6732   finally
6733     DeactivateGlobalWriteLock;
6734   end;
6735 end;
6736 
TCodeCompletionCodeTool.DeclareVariableNearBynull6737 function TCodeCompletionCodeTool.DeclareVariableNearBy(
6738   InsertPos: TCodeXYPosition; const VariableName, NewType, NewUnitName: string;
6739   Visibility: TCodeTreeNodeDesc; SourceChangeCache: TSourceChangeCache;
6740   LevelPos: TCodeXYPosition): boolean;
6741 var
6742   CleanCursorPos: integer;
6743   CursorNode: TCodeTreeNode;
6744   NewPos: TCodeXYPosition;
6745   NewTopLine: integer;
6746   Node: TCodeTreeNode;
6747   ClassPart: TNewClassPart;
6748   LevelCleanPos: integer;
6749 begin
6750   Result:=false;
6751   {$IFDEF CTDEBUG}
6752   debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy InsertPos=',dbgs(InsertPos),' Name="',VariableName,'" Type="',NewType,'" Unit=',NewUnitName,' LevelPos=',dbgs(LevelPos)]);
6753   {$ENDIF}
6754   BuildTreeAndGetCleanPos(InsertPos,CleanCursorPos);
6755   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6756   CaretToCleanPos(LevelPos,LevelCleanPos);
6757   if LevelCleanPos>0 then begin
6758     Node:=FindDeepestNodeAtPos(LevelCleanPos,false);
6759     while Node<>nil do begin
6760       //debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy Node=',Node.DescAsString]);
6761       if Node.Desc in AllClassObjects then begin
6762         // class member
6763         debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy class member']);
6764         // initialize class for code completion
6765         InitClassCompletion(Node,SourceChangeCache);
6766         // check if variable already exists
6767         if VarExistsInCodeCompleteClass(UpperCaseStr(VariableName)) then begin
6768           debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy member already exists: ',VariableName,' Class=',ExtractClassName(Node,false)]);
6769           exit;
6770         end;
6771         ClassPart:=ncpPublishedVars;
6772         case Visibility of
6773         ctnClassPrivate: ClassPart:=ncpPrivateVars;
6774         ctnClassProtected: ClassPart:=ncpProtectedVars;
6775         ctnClassPublic: ClassPart:=ncpPublicVars;
6776         end;
6777         AddClassInsertion(UpperCaseStr(VariableName),
6778                           VariableName+':'+NewType+';',VariableName,ClassPart);
6779         if not InsertAllNewClassParts then
6780           RaiseException(20170421201717,ctsErrorDuringInsertingNewClassParts);
6781         if (NewUnitName<>'')
6782         and (not IsHiddenUsedUnit(PChar(NewUnitName)))
6783         and (not AddUnitToMainUsesSection(NewUnitName,'',SourceChangeCache)) then
6784         begin
6785           debugln(['TCodeCompletionCodeTool.DeclareVariableNearBy AddUnitToMainUsesSection for new class memeber failed']);
6786           exit;
6787         end;
6788         // apply the changes
6789         if not SourceChangeCache.Apply then
6790           RaiseException(20170421201720,ctsUnableToApplyChanges);
6791         exit(true);
6792       end;
6793       Node:=Node.Parent;
6794     end;
6795   end;
6796   SourceChangeCache.MainScanner:=Scanner;
6797   Node:=CursorNode;
6798   Result:=AddLocalVariable(CleanCursorPos,1,VariableName,NewType,NewUnitName,
6799                            NewPos,NewTopLine,SourceChangeCache,LevelCleanPos);
6800 end;
6801 
TCodeCompletionCodeTool.DeclareVariableAtnull6802 function TCodeCompletionCodeTool.DeclareVariableAt(CursorPos: TCodeXYPosition;
6803   const VariableName, NewType, NewUnitName: string;
6804   SourceChangeCache: TSourceChangeCache): boolean;
6805 var
6806   CleanCursorPos: integer;
6807   CursorNode: TCodeTreeNode;
6808   NewCode: String;
6809   FrontGap: TGapTyp;
6810   AfterGap: TGapTyp;
6811   InsertPos: Integer;
6812   Indent: Integer;
6813   Node: TCodeTreeNode;
6814   NeedSection: Boolean;
6815   Beauty: TBeautifyCodeOptions;
6816 begin
6817   Result:=false;
6818   {$IFDEF CTDEBUG}
6819   debugln(['TCodeCompletionCodeTool.DeclareVariableAt CursorPos=',dbgs(CursorPos),' Name="',VariableName,'" Type="',NewType,'" Unit=',NewUnitName]);
6820   {$ENDIF}
6821   BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
6822   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6823   SourceChangeCache.MainScanner:=Scanner;
6824   InsertPos:=CleanCursorPos;
6825   Indent:=0;
6826   FrontGap:=gtNewLine;
6827   AfterGap:=gtNewLine;
6828   Beauty:=SourceChangeCache.BeautifyCodeOptions;
6829   {$IFDEF CTDEBUG}
6830   debugln(['TCodeCompletionCodeTool.DeclareVariableAt CursorNode=',CursorNode.DescAsString]);
6831   {$ENDIF}
6832   NewCode:=VariableName+':'+NewType+';';
6833   NeedSection:=false;
6834   if CursorNode.Desc=ctnVarDefinition then begin
6835     // insert in front of another var
6836     CursorNode:=GetFirstGroupVarNode(CursorNode);
6837     InsertPos:=CursorNode.StartPos;
6838     Indent:=Beauty.GetLineIndent(Src,InsertPos);
6839   end else if CursorNode.Desc in (AllClassBaseSections
6840     +[ctnVarSection,ctnRecordType,ctnClassClassVar])
6841   then begin
6842     // insert into a var section
6843     if (CursorNode.FirstChild=nil)
6844     or (CursorNode.FirstChild.StartPos>InsertPos) then begin
6845       MoveCursorToNodeStart(CursorNode);
6846       ReadNextAtom;
6847       if (CurPos.EndPos<CursorNode.EndPos)
6848       and ((CursorNode.FirstChild=nil) or (CursorNode.FirstChild.StartPos>CurPos.EndPos))
6849       and (InsertPos<CurPos.EndPos) then
6850         InsertPos:=CurPos.EndPos;
6851     end;
6852     if CursorNode.FirstChild<>nil then
6853       Indent:=Beauty.GetLineIndent(Src,CursorNode.FirstChild.StartPos)
6854     else
6855       Indent:=Beauty.GetLineIndent(Src,CursorNode.StartPos)+Beauty.Indent;
6856   end else if CursorNode.Desc in [ctnProcedure,ctnInterface,ctnImplementation,
6857     ctnProgram,ctnLibrary,ctnPackage]
6858   then begin
6859     Node:=CursorNode.FirstChild;
6860     if (Node<>nil) and (Node.Desc=ctnSrcName) then
6861       Node:=Node.NextBrother;
6862     // make sure to insert behind uses section and proc header
6863     if (Node<>nil) and (Node.Desc in [ctnUsesSection,ctnProcedureHead]) then
6864     begin
6865       if (Node<>nil) and (InsertPos<Node.EndPos) then
6866         InsertPos:=Node.EndPos;
6867     end;
6868     // find node in front
6869     while (Node<>nil) and (Node.NextBrother<>nil)
6870     and (Node.NextBrother.StartPos<InsertPos) do
6871       Node:=Node.NextBrother;
6872     if (Node<>nil) and (Node.Desc=ctnVarSection) then begin
6873       // append to a var section
6874       if Node.LastChild<>nil then
6875         Indent:=Beauty.GetLineIndent(Src,Node.LastChild.StartPos)
6876       else
6877         Indent:=Beauty.GetLineIndent(Src,Node.StartPos)+Beauty.Indent;
6878     end else begin
6879       // start a new var section
6880       NeedSection:=true;
6881       if Node<>nil then
6882         Indent:=Beauty.GetLineIndent(Src,Node.StartPos)
6883       else if CursorNode.FirstChild<>nil then
6884         Indent:=Beauty.GetLineIndent(Src,CursorNode.FirstChild.StartPos)
6885       else
6886         Indent:=Beauty.GetLineIndent(Src,CursorNode.StartPos);
6887     end;
6888   end else begin
6889     // default: add the variable at cursor
6890     NeedSection:=true;
6891   end;
6892   if NeedSection then
6893     NewCode:='var'+Beauty.LineEnd+Beauty.GetIndentStr(Beauty.Indent)+NewCode;
6894   NewCode:=Beauty.BeautifyStatement(NewCode,Indent,[bcfIndentExistingLineBreaks]);
6895 
6896   SourceChangeCache.BeginUpdate;
6897   try
6898     if (NewUnitName<>'') then begin
6899       if not AddUnitToMainUsesSection(NewUnitName,'',SourceChangeCache) then begin
6900         debugln(['TCodeCompletionCodeTool.DeclareVariableAt AddUnitToMainUsesSection failed']);
6901         exit;
6902       end;
6903     end;
6904     {$IFDEF VerboseCompletionAdds}
6905     debugln(['TCodeCompletionCodeTool.DeclareVariableAt NewCode="',dbgstr(NewCode),'"']);
6906     {$ENDIF}
6907     if not SourceChangeCache.Replace(FrontGap,AfterGap,InsertPos,InsertPos,NewCode)
6908     then exit;
6909     Result:=true;
6910   finally
6911     if not Result then
6912       SourceChangeCache.Clear;
6913     if not SourceChangeCache.EndUpdate then
6914       Result:=false;
6915   end;
6916 end;
6917 
InitClassCompletionnull6918 function TCodeCompletionCodeTool.InitClassCompletion(
6919   const AClassName: string;
6920   SourceChangeCache: TSourceChangeCache): boolean;
6921 var
6922   ClassNode: TCodeTreeNode;
6923 begin
6924   Result:=false;
6925   BuildTree(lsrInitializationStart);
6926   if ScannedRange<>lsrEnd then exit;
6927   if (SourceChangeCache=nil) or (Scanner=nil) then exit;
6928   ClassNode:=FindClassNodeInUnit(AClassName,true,false,false,true);
6929   Result:=InitClassCompletion(ClassNode,SourceChangeCache);
6930 end;
6931 
InitClassCompletionnull6932 function TCodeCompletionCodeTool.InitClassCompletion(ClassNode: TCodeTreeNode;
6933   SourceChangeCache: TSourceChangeCache): boolean;
6934 begin
6935   if (ClassNode=nil) then exit(false);
6936   CodeCompleteClassNode:=ClassNode;
6937   CodeCompleteSrcChgCache:=SourceChangeCache;
6938   FreeClassInsertionList;
6939   Result:=true;
6940 end;
6941 
TCodeCompletionCodeTool.ApplyClassCompletionnull6942 function TCodeCompletionCodeTool.ApplyClassCompletion(
6943   AddMissingProcBodies: boolean): boolean;
6944 begin
6945   Result:=false;
6946   try
6947     // insert all new class parts
6948     if not InsertAllNewClassParts then
6949       RaiseException(20170421201722,ctsErrorDuringInsertingNewClassParts);
6950     // insert all missing proc bodies
6951     if AddMissingProcBodies and (not CreateMissingClassProcBodies(true)) then
6952       RaiseException(20170421201724,ctsErrorDuringCreationOfNewProcBodies);
6953     // apply the changes
6954     if not CodeCompleteSrcChgCache.Apply then
6955       RaiseException(20170421201726,ctsUnableToApplyChanges);
6956     Result:=true;
6957   finally
6958     FreeClassInsertionList;
6959   end;
6960 end;
6961 
CompletePropertynull6962 function TCodeCompletionCodeTool.CompleteProperty(
6963   PropNode: TCodeTreeNode): boolean;
6964 {
6965  examples:
6966    property Visible;
6967    property Count: integer;
6968    property Color: TColor read FColor write SetColor;
6969    property Items[Index1, Index2: integer]: integer read GetItems; default;
6970    property X: integer index 1 read GetCoords write SetCoords stored IsStored;
6971    property C: char read GetC stored False default 'A';
6972    property Col8: ICol8 read FCol8 write FCol8 implements ICol8, IColor;
6973    property Visible: WordBool readonly dispid 401;
6974 
6975    property specifiers without parameters:
6976      ;nodefault, ;default
6977 
6978    property specifiers with parameters:
6979      index <id or number>, read <id>, write <id>, stored <id>,
6980      default <constant>, implements <id>[,<id>...]
6981 }
6982 type
6983   TPropPart = (ppName,       // property name
6984                ppParamList,  // param list
6985                ppType,       // type identifier
6986                ppIndexWord,  // 'index'
6987                ppIndex,      // index constant
6988                ppReadWord,   // 'read'
6989                ppRead,       // read identifier
6990                ppWriteWord,  // 'write'
6991                ppWrite,      // write identifier
6992                ppStoredWord, // 'stored'
6993                ppStored,     // stored identifier
6994                ppImplementsWord,// 'implements'
6995                ppImplements, // implements identifier
6996                ppDefaultWord,// 'default'  (the default value keyword,
6997                              //             not the default property)
6998                ppDefault,    // default constant
6999                ppNoDefaultWord,// 'nodefault'
7000                ppDispidWord, // 'dispid'
7001                ppDispid      // dispid constant
7002                );
7003 
7004 var
7005   Parts: array[TPropPart] of TAtomPosition;
7006   PartIsAtom: array[TPropPart] of boolean; // is single identifier
7007 
7008   procedure ReadSimpleSpec(SpecWord, SpecParam: TPropPart);
7009   // allowed after simple specifier like 'read':
7010   //   one semicolon
7011   //   or an <identifier>
7012   //   or an <identifier>.<identifier>
7013   //   (only read, write: ) or an <identifier>[ordinal expression]
7014   //   or a specifier
7015   begin
7016     if Parts[SpecWord].StartPos>=1 then
7017       RaiseExceptionFmt(20170421201731,ctsPropertySpecifierAlreadyDefined,[GetAtom]);
7018     Parts[SpecWord]:=CurPos;
7019     ReadNextAtom;
7020     if AtomIsChar(';') then exit;
7021     AtomIsIdentifierE;
7022     if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7023       CurPos.EndPos-CurPos.StartPos)
7024     then
7025       exit;
7026     Parts[SpecParam]:=CurPos;
7027     ReadNextAtom;
7028     while CurPos.Flag=cafPoint do begin
7029       ReadNextAtom;
7030       AtomIsIdentifierE;
7031       ReadNextAtom;
7032       PartIsAtom[SpecParam]:=false;
7033       Parts[SpecParam].EndPos:=CurPos.EndPos;
7034     end;
7035     if (SpecParam in [ppRead,ppWrite])
7036     and (CurPos.Flag=cafEdgedBracketOpen) then begin
7037       // array access
7038       PartIsAtom[SpecParam]:=false;
7039       ReadTilBracketClose(true);
7040       ReadNextAtom;
7041     end;
7042   end;
7043 
7044 var
7045   CleanAccessFunc, CleanParamList, ParamList, PropName, PropType, VariableName: string;
7046   IsClassProp: boolean;
7047   InsertPos: integer;
7048   BeautifyCodeOpts: TBeautifyCodeOptions;
7049   IndexType: string;
7050 
7051   procedure InitCompleteProperty;
7052   var APart: TPropPart;
7053   begin
7054     for APart:=Low(TPropPart) to High(TPropPart) do begin
7055       Parts[APart].StartPos:=-1;
7056       PartIsAtom[APart]:=true;
7057     end;
7058     IndexType:='Integer';
7059   end;
7060 
7061   procedure ReadPropertyKeywordAndName;
7062   begin
7063     MoveCursorToNodeStart(PropNode);
7064     ReadNextAtom; // read 'property'
7065     IsClassProp:=false;
7066     if UpAtomIs('CLASS') then begin
7067       IsClassProp:=true;
7068       ReadNextAtom;
7069     end;
7070     ReadNextAtom; // read name
7071     Parts[ppName]:=CurPos;
7072     PropName := copy(Src,Parts[ppName].StartPos,
7073       Parts[ppName].EndPos-Parts[ppName].StartPos);
7074     if (PropName <> '') and (PropName[1] = '&') then//property name starts with '&'
7075       Delete(PropName, 1, 1);
7076     ReadNextAtom;
7077   end;
7078 
7079   procedure ReadPropertyParamList;
7080   begin
7081     if AtomIsChar('[') then begin
7082       // read parameter list '[ ... ]'
7083       Parts[ppParamList].StartPos:=CurPos.StartPos;
7084       InitExtraction;
7085       if not ReadParamList(true,true,[phpInUpperCase,phpWithoutBrackets])
7086       then begin
7087         {$IFDEF CTDEBUG}
7088         DebugLn('[TCodeCompletionCodeTool.CompleteProperty] error parsing param list');
7089         {$ENDIF}
7090         RaiseException(20170421201733,ctsErrorInParamList);
7091       end;
7092       CleanParamList:=GetExtraction(true);
7093       Parts[ppParamList].EndPos:=CurPos.EndPos;
7094     end else
7095       CleanParamList:='';
7096   end;
7097 
ReadPropertyTypenull7098   function ReadPropertyType: string;
7099 
7100     procedure CheckIdentifier;
7101     begin
7102       if (CurPos.StartPos>PropNode.EndPos)
7103       or UpAtomIs('END') or AtomIsChar(';') or (not AtomIsIdentifier)
7104       or AtomIsKeyWord then begin
7105         // no type name found -> ignore this property
7106         RaiseExceptionFmt(20170421201735,ctsPropertTypeExpectedButAtomFound,[GetAtom]);
7107       end;
7108     end;
7109 
7110   var
7111     p: Integer;
7112   begin
7113     ReadNextAtom; // read type
7114     CheckIdentifier;
7115     Parts[ppType]:=CurPos;
7116     Result:=GetAtom;
7117     ReadTypeReference(false);
7118     p:=LastAtoms.GetPriorAtom.EndPos;
7119     if p>Parts[ppType].EndPos then begin
7120       Parts[ppType].EndPos:=p;
7121       Result:=ExtractCode(Parts[ppType].StartPos,Parts[ppType].EndPos,[]);
7122     end;
7123   end;
7124 
7125   procedure ReadIndexSpecifier;
7126   var
7127     Last: TAtomPosition;
7128   begin
7129     if UpAtomIs('INDEX') then begin
7130       if Parts[ppIndexWord].StartPos>=1 then
7131         RaiseException(20170421201737,ctsIndexSpecifierRedefined);
7132       Parts[ppIndexWord]:=CurPos;
7133       ReadNextAtom;
7134       if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7135         CurPos.EndPos-CurPos.StartPos) then
7136         RaiseExceptionFmt(20170421201740,ctsIndexParameterExpectedButAtomFound,[GetAtom]);
7137       Parts[ppIndex].StartPos:=CurPos.StartPos;
7138       ReadConstant(true,false,[]);
7139       Last:=LastAtoms.GetPriorAtom;
7140       Parts[ppIndex].EndPos:=Last.EndPos;
7141       PartIsAtom[ppIndex]:=false;
7142     end;
7143   end;
7144 
7145   procedure ReadDispidSpecifier;
7146   begin
7147     if UpAtomIs('DISPID') then begin
7148       if Parts[ppDispidWord].StartPos>=1 then
7149         RaiseException(20170421201742,ctsDispidSpecifierRedefined);
7150       Parts[ppDispidWord]:=CurPos;
7151       ReadNextAtom;
7152       if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7153         CurPos.EndPos-CurPos.StartPos) then
7154         RaiseExceptionFmt(20170421201744,ctsDispidParameterExpectedButAtomFound,[GetAtom]);
7155       Parts[ppDispid].StartPos:=CurPos.StartPos;
7156       ReadConstant(true,false,[]);
7157       Parts[ppDispid].EndPos:=LastAtoms.GetPriorAtom.EndPos;
7158       PartIsAtom[ppDispid]:=false;
7159     end;
7160   end;
7161 
7162   procedure ReadReadSpecifier;
7163   begin
7164     if UpAtomIs('READ') then ReadSimpleSpec(ppReadWord,ppRead);
7165   end;
7166 
7167   procedure ReadWriteSpecifier;
7168   begin
7169     if UpAtomIs('WRITE') then ReadSimpleSpec(ppWriteWord,ppWrite);
7170   end;
7171 
7172   procedure ReadOptionalSpecifiers;
7173   begin
7174     while (CurPos.StartPos<PropNode.EndPos) do begin
7175       if (CurPos.Flag in [cafSemicolon,cafEnd]) then break;
7176       if UpAtomIs('STORED') then begin
7177         ReadSimpleSpec(ppStoredWord,ppStored);
7178       end else if UpAtomIs('DEFAULT') then begin
7179         if Parts[ppDefaultWord].StartPos>=1 then
7180           RaiseException(20170421201746,ctsDefaultSpecifierRedefined);
7181         Parts[ppDefaultWord]:=CurPos;
7182         ReadNextAtom;
7183         if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7184           CurPos.EndPos-CurPos.StartPos) then
7185           RaiseExceptionFmt(20170421201748,ctsDefaultParameterExpectedButAtomFound,[GetAtom]);
7186         Parts[ppDefault].StartPos:=CurPos.StartPos;
7187         ReadConstant(true,false,[]);
7188         Parts[ppDefault].EndPos:=LastAtoms.GetPriorAtom.EndPos;
7189         PartIsAtom[ppDefault]:=false;
7190       end else if UpAtomIs('NODEFAULT') then begin
7191         if Parts[ppNoDefaultWord].StartPos>=1 then
7192           RaiseException(20170421201750,ctsNodefaultSpecifierDefinedTwice);
7193         Parts[ppNoDefaultWord]:=CurPos;
7194         ReadNextAtom;
7195       end else if UpAtomIs('IMPLEMENTS') then begin
7196         ReadSimpleSpec(ppImplementsWord,ppImplements);
7197         while CurPos.Flag=cafComma do begin
7198           ReadNextAtom;
7199           AtomIsIdentifierE;
7200           if WordIsPropertySpecifier.DoItCaseInsensitive(Src,CurPos.StartPos,
7201             CurPos.EndPos-CurPos.StartPos) then
7202             RaiseExceptionFmt(20170421201752,ctsIndexParameterExpectedButAtomFound,[GetAtom]);
7203           ReadNextAtom;
7204         end;
7205       end else
7206         RaiseExceptionFmt(20170421201755,ctsStrExpectedButAtomFound,[';',GetAtom]);
7207     end;
7208   end;
7209 
7210   procedure ResolveIndexType;
7211   var
7212     ExprType: TExpressionType;
7213     Params: TFindDeclarationParams;
7214   begin
7215     Params:=TFindDeclarationParams.Create;
7216     try
7217       Params.Flags:=fdfDefaultForExpressions;
7218       Params.ContextNode:=PropNode;
7219       IndexType:=FindTermTypeAsString(Parts[ppIndex],Params,ExprType);
7220     finally
7221       Params.Free;
7222     end;
7223   end;
7224 
7225   procedure CompleteReadSpecifier;
7226   var
7227     IsGetterFunc: boolean;
7228     VarCode: String;
7229     AccessParamPrefix: String;
7230     AccessParam: String;
7231     AccessFunc: String;
7232   begin
7233     // check read specifier
7234     VariableName:='';
7235     if not PartIsAtom[ppRead] then exit;
7236     if (Parts[ppReadWord].StartPos<=0) and (Parts[ppWriteWord].StartPos>0) then
7237       exit;
7238     {$IFDEF CTDEBUG}
7239     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] read specifier needed');
7240     {$ENDIF}
7241     AccessParamPrefix:=BeautifyCodeOpts.PropertyReadIdentPrefix;
7242     if Parts[ppRead].StartPos>0 then
7243       AccessParam:=copy(Src,Parts[ppRead].StartPos,
7244                         Parts[ppRead].EndPos-Parts[ppRead].StartPos)
7245     else begin
7246       if (Parts[ppParamList].StartPos>0) or (Parts[ppIndexWord].StartPos>0)
7247       or (SysUtils.CompareText(AccessParamPrefix,
7248               LeftStr(AccessParam,length(AccessParamPrefix)))=0)
7249       or (CodeCompleteClassNode.Desc in AllClassInterfaces) then
7250       begin
7251         // create the default read identifier for a function
AccessParamnull7252         AccessParam:=AccessParamPrefix+PropName;
7253       end else begin
7254         // create the default read identifier for a variable
7255         AccessParam:=BeautifyCodeOpts.PrivateVariablePrefix+PropName;
7256       end;
7257     end;
7258 
7259     // complete read identifier in property definition
7260     if (Parts[ppRead].StartPos<0) and CompleteProperties then begin
7261       // insert read specifier
7262       if Parts[ppReadWord].StartPos>0 then begin
7263         // 'read' keyword exists -> insert read identifier behind
7264         InsertPos:=Parts[ppReadWord].EndPos;
7265         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,AccessParam);
7266       end else begin
7267         // 'read' keyword does not exist -> insert behind index and type
7268         if Parts[ppIndex].StartPos>0 then
7269           InsertPos:=Parts[ppIndex].EndPos
7270         else if Parts[ppIndexWord].StartPos>0 then
7271           InsertPos:=Parts[ppIndexWord].EndPos
7272         else
7273           InsertPos:=Parts[ppType].EndPos;
7274         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7275            BeautifyCodeOpts.BeautifyKeyWord('read')+' '+AccessParam);
7276       end;
7277     end;
7278 
7279     IsGetterFunc:=(Parts[ppParamList].StartPos>0)
7280       or ((Parts[ppIndexWord].StartPos>0)
7281           and not VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)))
7282       or (SysUtils.CompareText(AccessParamPrefix,
7283             LeftStr(AccessParam,length(AccessParamPrefix)))=0)
7284       or (CodeCompleteClassNode.Desc in AllClassInterfaces);
7285     if not IsGetterFunc then
7286       VariableName:=AccessParam;
7287 
7288     // check if read access method exists
7289     if (Parts[ppIndexWord].StartPos<1) then begin
7290       if (Parts[ppParamList].StartPos>0) then begin
7291         // param list, no index
7292         CleanAccessFunc:=UpperCaseStr(AccessParam)+'('+CleanParamList+');';
7293       end else begin
7294         // no param list, no index
7295         CleanAccessFunc:=UpperCaseStr(AccessParam)+';';
7296       end;
7297     end else begin
7298       // ToDo: find out type of index
7299       if (Parts[ppParamList].StartPos>0) then begin
7300         // param list + index
7301         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+CleanParamList+';'+IndexType+');');
7302       end else begin
7303         // index, no param list
7304         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+IndexType+');');
7305       end;
7306     end;
7307     if ProcExistsInCodeCompleteClass(CleanAccessFunc) then exit;
7308 
7309     // check if read access variable exists
7310     if (Parts[ppParamList].StartPos<1)
7311     and (CodeCompleteClassNode.Desc in AllClassObjects)
7312     and VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)) then exit;
7313 
7314     // complete read access specifier
7315     if IsGetterFunc then begin
7316       // the read identifier is a function
7317       {$IFDEF CTDEBUG}
7318       DebugLn('[TCodeCompletionCodeTool.CompleteProperty] CleanAccessFunc ',CleanAccessFunc,' does not exist');
7319       {$ENDIF}
7320       // add insert demand for function
7321       // build function code
7322       if (Parts[ppParamList].StartPos>0) then begin
7323         MoveCursorToCleanPos(Parts[ppParamList].StartPos);
7324         ReadNextAtom;
7325         InitExtraction;
7326         if not ReadParamList(true,true,[phpWithParameterNames,
7327                              phpWithoutBrackets,phpWithVarModifiers,
7328                              phpWithComments])
7329         then begin
7330           {$IFDEF CTDEBUG}
7331           DebugLn('[TCodeCompletionCodeTool.CompleteProperty] Error reading param list');
7332           {$ENDIF}
7333           RaiseException(20170421201756,ctsErrorInParamList);
7334         end;
7335         ParamList:=GetExtraction(false);
7336         if (Parts[ppIndexWord].StartPos<1) then begin
7337           // param list, no index
7338           AccessFunc:='function '+AccessParam
7339                       +'('+ParamList+'):'+PropType+';';
7340         end else begin
7341           // param list + index
7342           AccessFunc:='function '+AccessParam
7343                       +'('+ParamList+'; AIndex:'+IndexType+'):'+PropType+';';
7344         end;
7345       end else begin
7346         if (Parts[ppIndexWord].StartPos<1) then begin
7347           // no param list, no index
7348           AccessFunc:='function '+AccessParam+':'+PropType+';';
7349         end else begin
7350           // index, no param list
7351           AccessFunc:='function '+AccessParam
7352                       +'(AIndex:'+IndexType+'):'+PropType+';';
7353         end;
7354       end;
7355       if IsClassProp then
7356         AccessFunc:='class '+AccessFunc+' static;';
7357       // add new Insert Node
7358       if CompleteProperties then
7359         AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7360                           ncpPrivateProcs,PropNode);
7361     end else begin
7362       // the read identifier is a variable
7363       // variable does not exist yet -> add insert demand for variable
7364       VarCode:=VariableName+':'+PropType+';';
7365       if IsClassProp then VarCode:='class var '+VarCode;
7366       AddClassInsertion(UpperCaseStr(VariableName),
7367          VarCode,VariableName,ncpPrivateVars,PropNode);
7368     end;
7369   end;
7370 
7371   procedure CompleteWriteSpecifier;
7372   var
7373     ProcBody: String;
7374     AccessParamPrefix: String;
7375     AccessParam: String;
7376     AccessFunc: String;
7377     AccessVariableName, AccessVariableNameParam: String;
7378   begin
7379     // check write specifier
7380     if not PartIsAtom[ppWrite] then exit;
7381     if (Parts[ppWriteWord].StartPos<1) and (Parts[ppReadWord].StartPos>0) then
7382       exit;
7383     {$IFDEF CTDEBUG}
7384     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] write specifier needed');
7385     {$ENDIF}
7386     AccessParamPrefix:=BeautifyCodeOpts.PropertyWriteIdentPrefix;
7387     if Parts[ppWrite].StartPos>0 then
7388       AccessParam:=copy(Src,Parts[ppWrite].StartPos,
7389             Parts[ppWrite].EndPos-Parts[ppWrite].StartPos)
7390     else
7391       AccessParam:=AccessParamPrefix+PropName;
7392 
7393     // complete property definition for write specifier
7394     if (Parts[ppWrite].StartPos<0) and CompleteProperties then begin
7395       // insert write specifier
7396       if Parts[ppWriteWord].StartPos>0 then begin
7397         // 'write' keyword exists -> insert write identifier behind
7398         InsertPos:=Parts[ppWriteWord].EndPos;
7399         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7400            AccessParam);
7401       end else begin
7402         // 'write' keyword does not exist
7403         //  -> insert behind type, index and write specifier
7404         if Parts[ppRead].StartPos>0 then
7405           InsertPos:=Parts[ppRead].EndPos
7406         else if Parts[ppReadWord].StartPos>0 then
7407           InsertPos:=Parts[ppReadWord].EndPos
7408         else if Parts[ppIndex].StartPos>0 then
7409           InsertPos:=Parts[ppIndex].EndPos
7410         else if Parts[ppIndexWord].StartPos>0 then
7411           InsertPos:=Parts[ppIndexWord].EndPos
7412         else
7413           InsertPos:=Parts[ppType].EndPos;
7414         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7415            BeautifyCodeOpts.BeautifyKeyWord('write')+' '+AccessParam);
7416       end;
7417     end;
7418 
7419     // check if write method exists
7420     if (Parts[ppIndexWord].StartPos<1) then begin
7421       if (Parts[ppParamList].StartPos>0) then begin
7422         // param list, no index
7423         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+CleanParamList+';'
7424                            +PropType+');');
7425       end else begin
7426         // no param list, no index
7427         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+PropType+');');
7428       end;
7429     end else begin
7430       // ToDo: find out index type
7431       if (Parts[ppParamList].StartPos>0) then begin
7432         // param list + index
7433         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+CleanParamList+';'+IndexType+';'+PropType+');');
7434       end else begin
7435         // index, no param list
7436         CleanAccessFunc:=UpperCaseStr(AccessParam+'('+IndexType+';'+PropType+');');
7437       end;
7438     end;
7439     if ProcExistsInCodeCompleteClass(CleanAccessFunc) then exit;
7440 
7441     // check if write variable exists
7442     if (Parts[ppParamList].StartPos<1)
7443     and (CodeCompleteClassNode.Desc in AllClassObjects)
7444     and VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)) then exit;
7445 
7446     // complete class
7447     if (Parts[ppParamList].StartPos>0)
7448     or ((Parts[ppIndexWord].StartPos>0)
7449         and not VarExistsInCodeCompleteClass(UpperCaseStr(AccessParam)))
7450     or (SysUtils.CompareText(AccessParamPrefix,
7451             LeftStr(AccessParam,length(AccessParamPrefix)))=0)
7452     or (CodeCompleteClassNode.Desc in AllClassInterfaces) then
7453     begin
7454       // add insert demand for function
7455       // build function code
7456       ProcBody:='';
7457       AccessVariableName := SetPropertyVariablename;
7458       if SetPropertyVariableIsPrefix then
7459         AccessVariableName := AccessVariableName+PropName;
7460       if SetPropertyVariableUseConst then
7461         AccessVariableNameParam := 'const '+AccessVariableName
7462       else
7463         AccessVariableNameParam := AccessVariableName;
7464       if (Parts[ppParamList].StartPos>0) then begin
7465         MoveCursorToCleanPos(Parts[ppParamList].StartPos);
7466         ReadNextAtom;
7467         InitExtraction;
7468         if not ReadParamList(true,true,[phpWithParameterNames,
7469                              phpWithoutBrackets,phpWithVarModifiers,
7470                              phpWithComments])
7471         then
7472           RaiseException(20170421201758,ctsErrorInParamList);
7473         ParamList:=GetExtraction(false);
7474         if (Parts[ppIndexWord].StartPos<1) then begin
7475           // param list, no index
7476           AccessFunc:='procedure '+AccessParam
7477                       +'('+ParamList+';'+AccessVariableNameParam+':'
7478                       +PropType+');';
7479         end else begin
7480           // param list+ index
7481           AccessFunc:='procedure '+AccessParam
7482                       +'('+ParamList+';AIndex:'+IndexType+';'
7483                       +AccessVariableNameParam+':'+PropType+');';
7484         end;
7485       end else begin
7486         if (Parts[ppIndexWord].StartPos<1) then begin
7487           // no param list, no index
7488           AccessFunc:=
7489             'procedure '+AccessParam
7490             +'('+AccessVariableNameParam+':'+PropType+');';
7491           if VariableName<>'' then begin
7492             { read spec is a variable -> add simple assign code to body
7493               For example:
7494 
7495               procedure SetMyInt(AValue: integer);
7496               begin
7497                 if FMyInt=AValue then exit;
7498                 FMyInt:=AValue;
7499               end;
7500 
7501             }
7502             {$IFDEF EnableCodeCompleteTemplates}
7503             if assigned(CTTemplateExpander)
7504             and CTTemplateExpander.TemplateExists('SetterMethod') then
7505             begin
7506               debugln(['CompleteWriteSpecifier ', 'USING template for SetterMethod']);
7507               ProcBody := CTTemplateExpander.Expand( 'SetterMethod',
7508                  BeautifyCodeOpts.LineEnd,
7509                  GetIndentStr(BeautifyCodeOpts.Indent),
7510                  ['ClassName',                                   'AccessParam','PropVarName',           'PropType','VarName'],
7511                  [ExtractClassName(PropNode.Parent.Parent,false), AccessParam,  SetPropertyVariablename, PropType,  VariableName] );
7512             end
7513             else
7514             {$ENDIF}
7515             begin
7516               ProcBody:=
7517                 'procedure '
7518                 +ExtractClassName(PropNode.Parent.Parent,false,true,Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE])+'.'+AccessParam
7519                 +'('+AccessVariableNameParam+':'+PropType+');'
7520                 +BeautifyCodeOpts.LineEnd
7521                 +'begin'+BeautifyCodeOpts.LineEnd
7522                 +BeautifyCodeOpts.GetIndentStr(BeautifyCodeOpts.Indent)
7523                   +'if '+VariableName+'='+AccessVariableName+' then Exit;'
7524                   +BeautifyCodeOpts.LineEnd
7525                 +BeautifyCodeOpts.GetIndentStr(BeautifyCodeOpts.Indent)
7526                   +VariableName+':='+AccessVariableName+';'
7527                   +BeautifyCodeOpts.LineEnd
7528                 +'end;';
7529             end;
7530             if IsClassProp then
7531               ProcBody:='class '+ProcBody;
7532           end;
7533         end else begin
7534           // index, no param list
7535           AccessFunc:='procedure '+AccessParam
7536                   +'(AIndex:'+IndexType+';'+AccessVariableNameParam+':'+PropType+');';
7537         end;
7538       end;
7539       // add new Insert Node
7540       if IsClassProp then
7541         AccessFunc:='class '+AccessFunc+' static;';
7542       if CompleteProperties then
7543         AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7544                           ncpPrivateProcs,PropNode,ProcBody);
7545     end else begin
7546       // the write identifier is a variable
7547       // -> add insert demand for variable
7548       if CompleteProperties then
7549         AddClassInsertion(UpperCaseStr(AccessParam),
7550            AccessParam+':'+PropType+';',AccessParam,ncpPrivateVars,PropNode);
7551     end;
7552   end;
7553 
7554   procedure CompleteStoredSpecifier;
7555   var
7556     AccessParam: String;
7557     AccessFunc: String;
7558   begin
7559     // check stored specifier
7560     if not PartIsAtom[ppStored] then exit;
7561     if (Parts[ppStoredWord].StartPos<1) then exit;
7562     {$IFDEF CTDEBUG}
7563     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] stored specifier needed');
7564     {$ENDIF}
7565     if Parts[ppStored].StartPos>0 then begin
7566       if (CompareIdentifiers(@Src[Parts[ppStored].StartPos],'False')=0)
7567       or (CompareIdentifiers(@Src[Parts[ppStored].StartPos],'True')=0) then
7568         exit;
7569       AccessParam:=copy(Src,Parts[ppStored].StartPos,
7570             Parts[ppStored].EndPos-Parts[ppStored].StartPos);
7571     end else
7572       AccessParam:=PropName
7573         +BeautifyCodeOpts.PropertyStoredIdentPostfix;
7574     if (Parts[ppIndexWord].StartPos<1) then begin
7575       // no index -> check if method or field exists
7576       CleanAccessFunc:=UpperCaseStr(AccessParam);
7577       if (not ProcExistsInCodeCompleteClass(CleanAccessFunc+';'))
7578       and (not VarExistsInCodeCompleteClass(CleanAccessFunc))
7579       then begin
7580         // add insert demand for function
7581         // build function code
7582         AccessFunc := 'function ' + AccessParam + ':Boolean;';
7583         CleanAccessFunc := CleanAccessFunc+';';
7584         if IsClassProp then
7585           AccessFunc:='class '+AccessFunc+' static;';;
7586         // add new Insert Node
7587         if CompleteProperties then
7588           AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7589                             ncpPrivateProcs,PropNode);
7590       end;
7591     end else begin
7592       // has index specifier -> check if method exists
7593       CleanAccessFunc:=UpperCaseStr(AccessParam);
7594       if (not ProcExistsInCodeCompleteClass(CleanAccessFunc+'('+UpperCaseStr(IndexType)+');'))
7595       and (not VarExistsInCodeCompleteClass(CleanAccessFunc))
7596       then begin
7597         // add insert demand for function
7598         // build function code
7599         AccessFunc := 'function ' + AccessParam + '(AIndex:'+IndexType+'):Boolean;';
7600         CleanAccessFunc := UpperCaseStr(CleanAccessFunc + '('+IndexType+');');
7601         if IsClassProp then
7602           AccessFunc:='class '+AccessFunc+' static;';
7603         // add new Insert Node
7604         if CompleteProperties then
7605           AddClassInsertion(CleanAccessFunc,AccessFunc,AccessParam,
7606                             ncpPrivateProcs,PropNode);
7607       end;
7608     end;
7609     if Parts[ppStored].StartPos<0 then begin
7610       // insert stored specifier
7611       InsertPos:=Parts[ppStoredWord].EndPos;
7612       if CompleteProperties then
7613         FSourceChangeCache.Replace(gtSpace,gtNone,InsertPos,InsertPos,
7614                                    AccessParam);
7615     end;
7616   end;
7617 
7618   procedure CompleteSemicolon;
7619   begin
7620     if (PropNode.EndPos<=SrcLen) and (Src[PropNode.EndPos-1]<>';') then begin
7621       InsertPos:=PropNode.EndPos;
7622       if CompleteProperties then
7623         FSourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,';');
7624     end;
7625   end;
7626 
7627 begin
7628   Result:=false;
7629   InitCompleteProperty;
7630   ReadPropertyKeywordAndName;
7631   ReadPropertyParamList;
7632 
7633   {$IFDEF CTDEBUG}
7634   DebugLn('[TCodeCompletionCodeTool.CompleteProperty] Checking Property ',GetAtom);
7635   {$ENDIF}
7636   if not AtomIsChar(':') then begin
7637     {$IFDEF CTDEBUG}
7638     DebugLn('[TCodeCompletionCodeTool.CompleteProperty] no type : found -> ignore property');
7639     {$ENDIF}
7640     // no type -> ignore this property
7641     Result:=true;
7642     exit;
7643   end;
7644 
7645   PropType:=ReadPropertyType;
7646   // parse specifiers
7647   if CodeCompleteClassNode.Desc <> ctnDispinterface then begin
7648     ReadIndexSpecifier;
7649     ReadReadSpecifier;
7650     ReadWriteSpecifier;
7651     ReadOptionalSpecifiers;
7652   end else begin
7653     if UpAtomIs('READONLY') or UpAtomIs('WRITEONLY') then
7654       ReadNextAtom;
7655     ReadDispidSpecifier;
7656   end;
7657 
7658   // complete property
7659   BeautifyCodeOpts:=FSourceChangeCache.BeautifyCodeOptions;
7660   if CodeCompleteClassNode.Desc <> ctnDispinterface then begin
7661     if Parts[ppIndex].StartPos>0 then
7662       ResolveIndexType;
7663     CompleteReadSpecifier;
7664     CompleteWriteSpecifier;
7665     CompleteStoredSpecifier;
7666   end;
7667   CompleteSemicolon;
7668 
7669   Result:=true;
7670 end;
7671 
TCodeCompletionCodeTool.GetFirstClassIdentifiernull7672 function TCodeCompletionCodeTool.GetFirstClassIdentifier(
7673   ClassNode: TCodeTreeNode): TCodeTreeNode;
7674 const
7675   Identifiers = AllIdentifierDefinitions+[ctnProperty,ctnProcedure,ctnClassGUID];
7676 begin
7677   if ClassNode=nil then exit(nil);
7678   Result:=ClassNode.FirstChild;
7679   while Result<>nil do begin
7680     if (Result.Desc in Identifiers) then
7681       exit;
7682     Result:=FindNextIdentNodeInClass(Result);
7683   end;
7684 end;
7685 
7686 procedure TCodeCompletionCodeTool.InsertNewClassParts(PartType: TNewClassPart);
7687 var ANodeExt: TCodeTreeNodeExtension;
7688   ClassSectionNode, ANode, InsertNode: TCodeTreeNode;
7689   Indent, InsertPos: integer;
7690   CurCode: string;
7691   IsVariable, InsertBehind: boolean;
7692   Visibility: TPascalClassSection;
7693   Beauty: TBeautifyCodeOptions;
7694 begin
7695   ANodeExt:=FirstInsert;
7696   Visibility:=NewClassPartVisibility[PartType];
7697   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
7698   // insert all nodes of specific type
7699   while ANodeExt<>nil do begin
7700     IsVariable:=NodeExtIsVariable(ANodeExt);
7701     if (cardinal(ord(PartType))=ANodeExt.Flags) then begin
7702       // search a destination section
7703       ClassSectionNode:=nil;
7704       if Visibility=pcsPublished then begin
7705         // insert into first published section
7706         ClassSectionNode:=CodeCompleteClassNode.FirstChild;
7707         while not (ClassSectionNode.Desc in AllClassSections) do
7708           ClassSectionNode:=ClassSectionNode.NextBrother;
7709         // the first class section is always a published section, even if there
7710         // is no 'published' keyword. If the class starts with the 'published'
7711         // keyword, then it will be more beautiful to insert vars and procs to
7712         // this second published section
7713         if (ClassSectionNode.FirstChild=nil)
7714         and (ClassSectionNode.NextBrother<>nil)
7715         and (ClassSectionNode.NextBrother.Desc=ctnClassPublished)
7716         then
7717           ClassSectionNode:=ClassSectionNode.NextBrother;
7718       end else if ANodeExt.Node<>nil then begin
7719         // search a section of the same Visibility in front of the node
7720         if CodeCompleteClassNode.Desc in AllClassObjects then
7721         begin
7722           ClassSectionNode:=ANodeExt.Node.Parent.PriorBrother;
7723           while (ClassSectionNode<>nil)
7724           and (ClassSectionNode.Desc<>ClassSectionNodeType[Visibility]) do
7725             ClassSectionNode:=ClassSectionNode.PriorBrother;
7726         end else begin
7727           ClassSectionNode:=CodeCompleteClassNode;
7728         end;
7729       end else begin
7730         // search a section of the same Visibility
7731         if CodeCompleteClassNode.Desc in AllClassObjects then
7732         begin
7733           ClassSectionNode:=CodeCompleteClassNode.FirstChild;
7734           while (ClassSectionNode<>nil)
7735           and (ClassSectionNode.Desc<>ClassSectionNodeType[Visibility]) do
7736             ClassSectionNode:=ClassSectionNode.NextBrother;
7737         end else begin
7738           ClassSectionNode:=CodeCompleteClassNode;
7739         end;
7740       end;
7741       if ClassSectionNode=nil then begin
7742         // there is no existing class section node
7743         // -> insert in the new one
7744         Indent:=NewClassSectionIndent[Visibility]+Beauty.Indent;
7745         InsertPos:=NewClassSectionInsertPos[Visibility];
7746         if InsertPos<1 then
7747           raise Exception.Create('TCodeCompletionCodeTool.InsertNewClassParts inconsistency: missing section: please create a bug report');
7748       end else begin
7749         // there is an existing class section to insert into
7750 
7751         // find a nice insert position
7752         InsertNode:=nil; // the new part will be inserted after this node
7753                          //   nil means insert as first
7754         InsertBehind:=true;
7755         ANode:=ClassSectionNode.FirstChild;
7756 
7757         // skip the class GUID
7758         if (ANode<>nil) and (ANode.Desc=ctnClassGUID) then begin
7759           InsertNode:=ANode;
7760           ANode:=ANode.NextBrother;
7761         end;
7762 
7763         // insert methods behind variables
7764         if not IsVariable then begin
7765           while (ANode<>nil) and (ANode.Desc=ctnVarDefinition) do begin
7766             InsertNode:=ANode;
7767             ANode:=ANode.NextBrother;
7768           end;
7769         end;
7770 
7771         // find a nice position between similar siblings
7772         case Beauty.ClassPartInsertPolicy of
7773 
7774         cpipAlphabetically:
7775           begin
7776             while ANode<>nil do begin
7777               if IsVariable then begin
7778                 // the insertion is a new variable
7779                 if (ANode.Desc<>ctnVarDefinition)
7780                 or (CompareNodeIdentChars(ANode,ANodeExt.Txt)<0) then
7781                   break;
7782               end else begin
7783                 // the insertion is a new method
7784                 case ANode.Desc of
7785 
7786                 ctnProcedure:
7787                   begin
7788                     CurCode:=ExtractProcName(ANode,[]);
7789                     if SysUtils.CompareText(CurCode,ANodeExt.ExtTxt2)>0 then
7790                       break;
7791                   end;
7792 
7793                 ctnProperty:
7794                   begin
7795                     if FSourceChangeCache.BeautifyCodeOptions
7796                         .MixMethodsAndProperties then
7797                     begin
7798                       CurCode:=ExtractPropName(ANode,false);
7799                       if SysUtils.CompareText(CurCode,ANodeExt.ExtTxt2)>0 then
7800                         break;
7801                     end else
7802                       break;
7803                   end;
7804 
7805                 end;
7806               end;
7807               InsertNode:=ANode;
7808               ANode:=ANode.NextBrother;
7809             end;
7810           end;
7811 
7812         else
7813           // cpipLast
7814           begin
7815             while ANode<>nil do begin
7816               if IsVariable then begin
7817                 // the insertion is a variable
7818                 if (ANode.Desc<>ctnVarDefinition) then
7819                   break;
7820               end else begin
7821                 // the insertion is a method
7822                 if (not Beauty.MixMethodsAndProperties)
7823                 and (ANode.Desc=ctnProperty) then
7824                   break;
7825               end;
7826               InsertNode:=ANode;
7827               ANode:=ANode.NextBrother;
7828             end;
7829           end
7830         end;
7831 
7832         if InsertNode<>nil then begin
7833           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert behind existing']);
7834           // for variable lists: a,b,c: integer
7835           // use last node
7836           if InsertBehind then begin
7837             while (InsertNode.Desc=ctnVarDefinition)
7838             and (InsertNode.FirstChild=nil)
7839             and (InsertNode.NextBrother<>nil)
7840             and (InsertNode.NextBrother.Desc=ctnVarDefinition) do
7841               InsertNode:=InsertNode.NextBrother;
7842           end;
7843 
7844           if (not IsVariable) and (InsertNode.Desc=ctnVarDefinition)
7845           and (InsertNode.NextBrother<>nil) then begin
7846             // insertion is a new method and it should be inserted behind
7847             // variables. Because methods and variables should be separated
7848             // there is a next node, insert the new method in front of the next
7849             // node, instead of inserting it right behind the variable.
7850             // This makes sure to use existing separation comments/empty lines.
7851             InsertNode:=InsertNode.NextBrother;
7852             InsertBehind:=false;
7853           end;
7854 
7855           Indent:=Beauty.GetLineIndent(Src,InsertNode.StartPos);
7856           if InsertBehind then begin
7857             // insert behind InsertNode
7858             InsertPos:=FindLineEndOrCodeAfterPosition(InsertNode.EndPos);
7859           end else begin
7860             // insert in front of InsertNode
7861             InsertPos:=InsertNode.StartPos;
7862           end;
7863         end else begin
7864           // insert as first variable/proc
7865           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first var: ',ClassSectionNode.DescAsString,' ',dbgstr(copy(Src,ClassSectionNode.StartPos,ClassSectionNode.EndPos-ClassSectionNode.StartPos))]);
7866           Indent:=Beauty.GetLineIndent(Src,ClassSectionNode.StartPos)+Beauty.Indent;
7867           InsertPos:=ClassSectionNode.StartPos;
7868           if (ClassSectionNode.Desc=ctnClassPublished)
7869           and (CompareIdentifiers(@Src[ClassSectionNode.StartPos],'published')<>0)
7870           then begin
7871             // the first published section has no keyword
7872             if ClassSectionNode.NextBrother<>nil then
7873               Indent:=Beauty.GetLineIndent(Src,ClassSectionNode.NextBrother.StartPos)
7874                       +Beauty.Indent
7875             else
7876               Indent:=Beauty.GetLineIndent(Src,ClassSectionNode.Parent.StartPos)
7877                       +Beauty.Indent;
7878           end else if (ClassSectionNode.Desc in AllClassBaseSections)
7879           then begin
7880             // skip keyword
7881             MoveCursorToCleanPos(InsertPos);
7882             ReadNextAtom;
7883             if UpAtomIs('STRICT') then
7884               ReadNextAtom;
7885             //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first of ',ClassSectionNode.DescAsString,' Atom=',GetAtom]);
7886             ANode:=ClassSectionNode.Next;
7887             if (ANode<>nil) and (CurPos.EndPos<=ANode.StartPos) then
7888               InsertPos:=CurPos.EndPos;
7889           end else if ClassSectionNode.Desc in AllClassInterfaces then begin
7890             // skip class interface header
7891             MoveCursorToCleanPos(InsertPos);
7892             ReadNextAtom; // skip 'interface'
7893             InsertPos:=CurPos.EndPos;
7894             if ReadNextAtomIsChar('(') then begin
7895               ReadTilBracketClose(true);
7896               InsertPos:=CurPos.EndPos;
7897             end;
7898           end;
7899           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first, somewhere after InsertPos=',CleanPosToStr(InsertPos)]);
7900           InsertPos:=FindLineEndOrCodeAfterPosition(InsertPos);
7901           //debugln(['TCodeCompletionCodeTool.InsertNewClassParts insert as first, InsertPos=',CleanPosToStr(InsertPos)]);
7902         end;
7903       end;
7904       CurCode:=ANodeExt.ExtTxt1;
7905       CurCode:=Beauty.BeautifyStatement(CurCode,Indent,[bcfChangeSymbolToBracketForGenericTypeBrackets]);
7906       {$IFDEF CTDEBUG}
7907       DebugLn('TCodeCompletionCodeTool.InsertNewClassParts:');
7908       DebugLn(CurCode);
7909       {$ENDIF}
7910       FSourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
7911          CurCode);
7912       if (not IsVariable) and (Beauty.MethodInsertPolicy=mipClassOrder) then
7913       begin
7914         // this was a new method definition and the body should be added in
7915         // Class Order
7916         // -> save information about the inserted position
7917         ANodeExt.Position:=InsertPos;
7918       end;
7919     end;
7920     ANodeExt:=ANodeExt.Next;
7921   end;
7922 end;
7923 
TCodeCompletionCodeTool.InsertAllNewClassPartsnull7924 function TCodeCompletionCodeTool.InsertAllNewClassParts: boolean;
7925 var
7926   NewSectionKeyWordNeeded: boolean;
7927   NewSection: TPascalClassSection;
7928   Beauty: TBeautifyCodeOptions;
7929 
GetTopMostPositionNodenull7930   function GetTopMostPositionNode(Visibility: TPascalClassSection
7931     ): TCodeTreeNode;
7932   var
7933     ANodeExt: TCodeTreeNodeExtension;
7934   begin
7935     Result:=nil;
7936     ANodeExt:=FirstInsert;
7937     while ANodeExt<>nil do begin
7938       if (ANodeExt.Node<>nil)
7939       and ((Result=nil) or (Result.StartPos>ANodeExt.Node.StartPos))
7940       and (NodeExtHasVisibilty(ANodeExt,Visibility))
7941       then
7942         Result:=ANodeExt.Node;
7943       ANodeExt:=ANodeExt.Next;
7944     end;
7945   end;
7946 
GetFirstNodeExtWithVisibilitynull7947   function GetFirstNodeExtWithVisibility(Visibility: TPascalClassSection
7948     ): TCodeTreeNodeExtension;
7949   begin
7950     Result:=FirstInsert;
7951     while Result<>nil do begin
7952       if NodeExtHasVisibilty(Result,Visibility) then
7953         break;
7954       Result:=Result.Next;
7955     end;
7956   end;
7957 
GetFirstVisibilitySectionNodenull7958   function GetFirstVisibilitySectionNode: TCodeTreeNode;
7959   begin
7960     if CodeCompleteClassNode.Desc in AllClassInterfaces then
7961       Result:=CodeCompleteClassNode
7962     else begin
7963       Result:=CodeCompleteClassNode.FirstChild;
7964       while not (Result.Desc in AllClassBaseSections) do
7965         Result:=Result.NextBrother;
7966     end;
7967   end;
7968 
7969   procedure AddClassSection(Visibility: TPascalClassSection);
7970   var
7971     TopMostPositionNode: TCodeTreeNode;
7972     SectionNode: TCodeTreeNode;
7973     SectionKeyWord: String;
7974     ANode: TCodeTreeNode;
7975     FirstVisibilitySection: TCodeTreeNode;
7976     NewCode: String;
7977     Beauty: TBeautifyCodeOptions;
7978   begin
7979     NewClassSectionInsertPos[Visibility]:=-1;
7980     NewClassSectionIndent[Visibility]:=0;
7981     if CodeCompleteClassNode.Desc in AllClassInterfaces then begin
7982       // a class interface has no sections
7983       exit;
7984     end;
7985 
7986     // check if section is needed
7987     if GetFirstNodeExtWithVisibility(Visibility)=nil then exit;
7988     // search topmost position node for this Visibility
7989     TopMostPositionNode:=GetTopMostPositionNode(Visibility);
7990     SectionNode:=nil;
7991     // search a Visibility section in front of topmost position node
7992     if TopMostPositionNode<>nil then begin
7993       SectionNode:=TopMostPositionNode;
7994       while (SectionNode<>nil) and (SectionNode.Parent<>CodeCompleteClassNode)
7995       do
7996         SectionNode:=SectionNode.Parent;
7997       if SectionNode<>nil then
7998         SectionNode:=SectionNode.PriorBrother;
7999     end else
8000       SectionNode:=CodeCompleteClassNode.LastChild;
8001     while (SectionNode<>nil)
8002     and (SectionNode.Desc<>ClassSectionNodeType[Visibility]) do
8003       SectionNode:=SectionNode.PriorBrother;
8004     if (SectionNode<>nil) then begin
8005       //DebugLn(['AddClassSection section exists for ',NodeDescriptionAsString(ClassSectionNodeType[Visibility])]);
8006       exit;
8007     end;
8008     { There is no section of this Visibility in front (or at all)
8009       -> Insert a new section in front of topmost node.
8010       Normally the best place for a new section is at the end of
8011       the first published section. But if a variable is already
8012       needed in the first published section, then the new section
8013       must be inserted in front of all }
8014     Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8015     FirstVisibilitySection:=GetFirstVisibilitySectionNode;
8016     if (TopMostPositionNode<>nil)
8017     and (FirstVisibilitySection<>nil)
8018     and ((TopMostPositionNode.HasAsParent(FirstVisibilitySection)
8019           or (TopMostPositionNode=FirstVisibilitySection)))
8020     then begin
8021       // topmost node is in the first section
8022       // -> insert the new section as the first section
8023       ANode:=FirstVisibilitySection;
8024       NewClassSectionIndent[Visibility]:=Beauty.GetLineIndent(Src,ANode.StartPos);
8025       if (ANode.FirstChild<>nil) and (ANode.FirstChild.Desc<>ctnClassGUID)
8026       then
8027         NewClassSectionInsertPos[Visibility]:=ANode.StartPos
8028       else
8029         NewClassSectionInsertPos[Visibility]:=ANode.FirstChild.EndPos;
8030       if (not NewSectionKeyWordNeeded)
8031       and (CompareNodeIdentChars(ANode, UpperCase(PascalClassSectionKeywords[NewSection]))<>0) then begin
8032         NewSectionKeyWordNeeded:=true;
8033         NewClassSectionInsertPos[NewSection]:=
8034           NewClassSectionInsertPos[Visibility];
8035         NewClassSectionIndent[NewSection]:=
8036           NewClassSectionIndent[Visibility];
8037       end;
8038     end else begin
8039       ANode:=nil;
8040       case Visibility of
8041       pcsProtected:
8042         // insert after last private section
8043         ANode:=FindLastClassSection(CodeCompleteClassNode,ctnClassPrivate);
8044       pcsPublic:
8045         begin
8046           // insert after last private, protected section
8047           ANode:=FindClassSection(CodeCompleteClassNode,ctnClassProtected);
8048           if ANode=nil then
8049             ANode:=FindClassSection(CodeCompleteClassNode,ctnClassPrivate);
8050         end;
8051       end;
8052       if ANode=nil then begin
8053         // default: insert new section behind first published section
8054         ANode:=FirstVisibilitySection;
8055       end;
8056       NewClassSectionIndent[Visibility]:=Beauty.GetLineIndent(Src,ANode.StartPos);
8057       NewClassSectionInsertPos[Visibility]:=ANode.EndPos;
8058     end;
8059     SectionKeyWord:=PascalClassSectionKeywords[Visibility];
8060     NewCode:=Beauty.BeautifyKeyWord(SectionKeyWord);
8061     FSourceChangeCache.Replace(gtNewLine,gtNewLine,
8062       NewClassSectionInsertPos[Visibility],
8063       NewClassSectionInsertPos[Visibility],
8064       Beauty.GetIndentStr(NewClassSectionIndent[Visibility])+NewCode);
8065   end;
8066 
8067 begin
8068   Result:=InsertClassHeaderComment;
8069   if not Result then exit;
8070 
8071   Result:=InsertMissingClassSemicolons;
8072   if not Result then exit;
8073 
8074   if FirstInsert=nil then begin
8075     Result:=true;
8076     exit;
8077   end;
8078   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8079 
8080   NewSectionKeyWordNeeded:=false;// 'published'/'public' keyword after first private section needed
8081   if CodeCompleteClassNode.Desc = ctnClass then
8082     NewSection := pcsPublished
8083   else
8084     NewSection := pcsPublic;
8085 
8086   AddClassSection(pcsPrivate);
8087   InsertNewClassParts(ncpPrivateVars);
8088   InsertNewClassParts(ncpPrivateProcs);
8089 
8090   AddClassSection(pcsProtected);
8091   InsertNewClassParts(ncpProtectedVars);
8092   InsertNewClassParts(ncpProtectedProcs);
8093 
8094   if NewSectionKeyWordNeeded and (NewSection = pcsPublic) then begin
8095     FSourceChangeCache.Replace(gtNewLine,gtNewLine,
8096       NewClassSectionInsertPos[NewSection],
8097       NewClassSectionInsertPos[NewSection],
8098       Beauty.GetIndentStr(NewClassSectionIndent[NewSection])+
8099         Beauty.BeautifyKeyWord(PascalClassSectionKeywords[NewSection]));
8100   end
8101   else
8102     AddClassSection(pcsPublic);
8103   InsertNewClassParts(ncpPublicVars);
8104   InsertNewClassParts(ncpPublicProcs);
8105 
8106   if NewSectionKeyWordNeeded and (NewSection = pcsPublished) then begin
8107     FSourceChangeCache.Replace(gtNewLine,gtNewLine,
8108       NewClassSectionInsertPos[NewSection],
8109       NewClassSectionInsertPos[NewSection],
8110       Beauty.GetIndentStr(NewClassSectionIndent[NewSection])+
8111         Beauty.BeautifyKeyWord(PascalClassSectionKeywords[NewSection]));
8112   end;
8113   InsertNewClassParts(ncpPublishedVars);
8114   InsertNewClassParts(ncpPublishedProcs);
8115 
8116   Result:=true;
8117 end;
8118 
InsertClassHeaderCommentnull8119 function TCodeCompletionCodeTool.InsertClassHeaderComment: boolean;
8120 var
8121   ClassNode: TCodeTreeNode;
8122   ClassIdentifierNode: TCodeTreeNode;
8123   Code: String;
8124   InsertPos: LongInt;
8125   Indent: LongInt;
8126   StartPos, CommentStart, CommentEnd: TCodeXYPosition;
8127   Beauty: TBeautifyCodeOptions;
8128 begin
8129   Result:=true;
8130   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8131   if not Beauty.ClassHeaderComments then exit;
8132   // check if there is already a comment in front of the class
8133 
8134   // find the start of the class (the position in front of the class name)
8135   ClassNode:=CodeCompleteClassNode;
8136   if ClassNode=nil then exit;
8137   ClassIdentifierNode:=
8138                    ClassNode.GetNodeOfTypes([ctnTypeDefinition,ctnGenericType]);
8139   if ClassIdentifierNode=nil then begin
8140     DebugLn('TCodeCompletionCodeTool.InsertClassHeaderComment WARNING: class without name', ClassNode.DescAsString);
8141     exit;
8142   end;
8143   if not CleanPosToCaret(ClassIdentifierNode.StartPos,StartPos) then exit;
8144   Code:=ExtractDefinitionName(ClassIdentifierNode);
8145 
8146   // check if there is already a comment in front
8147   if FindCommentInFront(StartPos,Code,false,true,false,false,true,true,
8148                         CommentStart,CommentEnd)
8149   then
8150     // comment already exists
8151     exit;
8152   if CommentStart.Code=nil then ;
8153   if CommentEnd.Code=nil then ;
8154 
8155   // insert comment in front
8156   InsertPos:=ClassIdentifierNode.StartPos;
8157   Indent:=Beauty.GetLineIndent(Src,InsertPos);
8158   Code:=Beauty.GetIndentStr(Indent)+'{ '+Code+' }';
8159   FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
8160                              InsertPos,InsertPos,Code);
8161 end;
8162 
InsertMissingClassSemicolonsnull8163 function TCodeCompletionCodeTool.InsertMissingClassSemicolons: boolean;
8164 var
8165   ANode: TCodeTreeNode;
8166   ProcCode: String;
8167 begin
8168   Result:=false;
8169   ANode:=FCompletingFirstEntryNode;
8170   while (ANode<>nil) do begin
8171     if ANode.Desc=ctnProcedure then begin
8172       if ANode.FirstChild=nil then begin
8173         debugln(['TCodeCompletionCodeTool.InsertMissingClassSemicolons warning: broken proc node: ',CleanPosToStr(ANode.StartPos)]);
8174         exit;
8175       end;
8176       ProcCode:=ExtractProcHead(ANode,[phpWithStart,
8177                   phpWithoutClassKeyword,
8178                   phpWithVarModifiers,phpWithParameterNames,phpWithResultType,
8179                   phpWithProcModifiers,phpDoNotAddSemicolon]);
8180       if (ProcCode<>'') and (ProcCode[length(ProcCode)]<>';') then begin
8181         // add missing semicolon at end of procedure head
8182         UndoReadNextAtom;
8183         {$IFDEF VerboseCompletionAdds}
8184         debugln(['TCodeCompletionCodeTool.InsertMissingClassSemicolons add missing semicolon at end of procedure head ProcCode="',dbgstr(ProcCode),'"']);
8185         {$ENDIF}
8186         if not FSourceChangeCache.Replace(gtNone,gtNone,
8187           CurPos.EndPos,CurPos.EndPos,';') then
8188             RaiseException(20170421201801,'InsertMissingClassSemicolons: unable to insert semicolon');
8189       end;
8190       MoveCursorToFirstProcSpecifier(ANode);
8191       if (CurPos.Flag<>cafSemicolon) and (CurPos.EndPos<ANode.FirstChild.EndPos)
8192       and (LastAtoms.HasPrior)
8193       then begin
8194         // add missing semicolon in front of proc modifiers
8195         UndoReadNextAtom;
8196         {$IFDEF VerboseCompletionAdds}
8197         debugln(['TCodeCompletionCodeTool.InsertMissingClassSemicolons add missing semicolon in front of proc modifiers ProcCode="',dbgstr(ProcCode),'"']);
8198         {$ENDIF}
8199         if not FSourceChangeCache.Replace(gtNone,gtNone,
8200           CurPos.EndPos,CurPos.EndPos,';') then
8201             RaiseException(20170421201804,'InsertMissingClassSemicolons: unable to insert semicolon');
8202       end;
8203     end;
8204     // next node
8205     if ANode.NextBrother<>nil then begin
8206       ANode:=ANode.NextBrother;
8207     end else begin
8208       ANode:=ANode.Parent.NextBrother;
8209       while (ANode<>nil) and (ANode.Desc in (AllCodeSections+AllClassSections))
8210       and (ANode.FirstChild=nil) do
8211         ANode:=ANode.NextBrother;
8212       if ANode<>nil then ANode:=ANode.FirstChild;
8213     end;
8214   end;
8215   Result:=true;
8216 end;
8217 
TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSectionnull8218 function TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection: boolean;
8219 var
8220   UsesNode: TCodeTreeNode;
8221   AVLNode: TAVLTreeNode;
8222   CurSourceName: String;
8223   SectionNode: TCodeTreeNode;
8224   NewUsesTerm: String;
8225   NewUnitName: String;
8226   InsertPos: LongInt;
8227 begin
8228   Result:=true;
8229   if (fNewMainUsesSectionUnits=nil) then exit;
8230   //DebugLn(['TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection ']);
8231   UsesNode:=FindMainUsesNode;
8232 
8233   // remove units, that are already in the uses section
8234   CurSourceName:=GetSourceName(false);
8235   RemoveNewMainUsesSectionUnit(PChar(CurSourceName)); // the unit itself
8236   if UsesNode<>nil then begin
8237     MoveCursorToNodeStart(UsesNode);
8238     ReadNextAtom; // read 'uses'
8239     repeat
8240       ReadNextAtom; // read name
8241       if AtomIsChar(';') then break;
8242       RemoveNewMainUsesSectionUnit(@Src[CurPos.StartPos]);
8243       if fNewMainUsesSectionUnits.Count=0 then exit;
8244       ReadNextAtom;
8245       if UpAtomIs('IN') then begin
8246         ReadNextAtom;
8247         ReadNextAtom;
8248       end;
8249       while AtomIsChar('.') do
8250       begin
8251         ReadNextAtom;
8252         ReadNextAtom;
8253       end;
8254       if AtomIsChar(';') then break;
8255       if not AtomIsChar(',') then break;
8256     until (CurPos.StartPos>SrcLen);
8257   end;
8258 
8259   // add units
8260   NewUsesTerm:='';
8261   AVLNode:=fNewMainUsesSectionUnits.FindLowest;
8262   while AVLNode<>nil do begin
8263     if NewUsesTerm<>'' then
8264       NewUsesTerm:=NewUsesTerm+', ';
8265     NewUnitName:=GetIdentifier(PChar(AVLNode.Data));
8266     //DebugLn(['TCodeCompletionCodeTool.InsertAllNewUnitsToMainUsesSection NewUnitName=',NewUnitName]);
8267     NewUsesTerm:=NewUsesTerm+NewUnitName;
8268     AVLNode:=fNewMainUsesSectionUnits.FindSuccessor(AVLNode);
8269   end;
8270   if UsesNode<>nil then begin
8271     // add unit to existing uses section
8272     MoveCursorToNodeStart(UsesNode); // for nice error position
8273     InsertPos:=UsesNode.EndPos-1; // position of semicolon at end of uses section
8274     NewUsesTerm:=', '+NewUsesTerm;
8275     if not FSourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,
8276                                       NewUsesTerm) then exit;
8277   end else begin
8278     // create a new uses section
8279     if Tree.Root=nil then exit;
8280     SectionNode:=Tree.Root;
8281     MoveCursorToNodeStart(SectionNode);
8282     ReadNextAtom;
8283     if UpAtomIs('UNIT') then begin
8284       // search interface
8285       SectionNode:=SectionNode.NextBrother;
8286       if (SectionNode=nil) or (SectionNode.Desc<>ctnInterface) then exit;
8287       MoveCursorToNodeStart(SectionNode);
8288       ReadNextAtom;
8289     end;
8290     InsertPos:=CurPos.EndPos;
8291     NewUsesTerm:=FSourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
8292                  +' '+NewUsesTerm+';';
8293     if not FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
8294                                      InsertPos,InsertPos,NewUsesTerm) then exit;
8295   end;
8296 end;
8297 
FindClassMethodsCommentnull8298 function TCodeCompletionCodeTool.FindClassMethodsComment(StartPos: integer; out
8299   CommentStart, CommentEnd: integer): boolean;
8300 var
8301   Code: String;
8302 begin
8303   Result:=false;
8304   Code:=ExtractClassName(CodeCompleteClassNode,false);
8305   // search the comment
8306   Result:=FindCommentInFront(StartPos,Code,false,false,false,true,true,
8307                              CommentStart,CommentEnd)
8308 end;
8309 
8310 procedure TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs(
8311   ClassProcs: TAVLTree;  const TheClassName: string);
8312 var ANodeExt: TCodeTreeNodeExtension;
8313   NewNodeExt: TCodeTreeNodeExtension;
8314   Beauty: TBeautifyCodeOptions;
8315 begin
8316   {$IFDEF CTDEBUG}
8317   DebugLn('[TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs]');
8318   {$ENDIF}
8319   // add new property access methods to ClassProcs
8320   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8321   ANodeExt:=FirstInsert;
8322   while ANodeExt<>nil do begin
8323     if not NodeExtIsVariable(ANodeExt) then begin
8324       if FindNodeExtInTree(ClassProcs,ANodeExt.Txt)=nil then begin
8325         NewNodeExt:=TCodeTreeNodeExtension.Create;
8326         with NewNodeExt do begin
8327           Txt:=UpperCaseStr(TheClassName)+'.'+ANodeExt.Txt; // Name+ParamTypeList
8328           ExtTxt1:=Beauty.AddClassAndNameToProc(
8329              ANodeExt.ExtTxt1,TheClassName,''); // complete proc head code
8330           ExtTxt3:=ANodeExt.ExtTxt3;
8331           Position:=ANodeExt.Position;
8332           {$IFDEF CTDEBUG}
8333           DebugLn('  Txt="',Txt,'"');
8334           DebugLn('  ExtTxt1="',ExtTxt1,'"');
8335           DebugLn('  ExtTxt3="',ExtTxt3,'"');
8336           {$ENDIF}
8337         end;
8338         ClassProcs.Add(NewNodeExt);
8339       end;
8340     end;
8341     ANodeExt:=ANodeExt.Next;
8342   end;
8343 end;
8344 
TCodeCompletionCodeTool.UpdateProcBodySignaturenull8345 function TCodeCompletionCodeTool.UpdateProcBodySignature(
8346   ProcBodyNodes: TAVLTree; const BodyNodeExt: TCodeTreeNodeExtension;
8347   ProcAttrCopyDefToBody: TProcHeadAttributes; var ProcsCopied: boolean;
8348   CaseSensitive: boolean): boolean;
8349 var
8350   OldProcCode: String;
8351   NewProcCode: String;
8352   InsertEndPos: LongInt;
8353   BodyProcHeadNode: TCodeTreeNode;
8354   Indent: LongInt;
8355   InsertPos: LongInt;
8356   DefNodeExt: TCodeTreeNodeExtension;
8357   Beauty: TBeautifyCodeOptions;
8358 begin
8359   Result:=true;
8360   DefNodeExt:=TCodeTreeNodeExtension(BodyNodeExt.Data);
8361   if DefNodeExt=nil then exit;
8362   // this body has a definition
8363   // compare body and definition
8364   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8365   NewProcCode:=ExtractProcHead(DefNodeExt.Node, ProcAttrCopyDefToBody);
8366   BodyProcHeadNode:=BodyNodeExt.Node.FirstChild;
8367   InsertPos:=BodyNodeExt.Node.StartPos;
8368   InsertEndPos:=BodyProcHeadNode.EndPos;
8369   Indent:=Beauty.GetLineIndent(Src, InsertPos);
8370   NewProcCode:=Beauty.BeautifyProc(NewProcCode, Indent, false);
8371   OldProcCode:=ExtractProcHead(BodyNodeExt.Node, ProcAttrCopyDefToBody);
8372   if CompareTextIgnoringSpace(NewProcCode, OldProcCode, CaseSensitive)<>0 then begin
8373     // update body
8374     //debugln(['TCodeCompletionCodeTool.UpdateProcBodySignatures Old="',dbgstr(OldProcCode),'" New="',dbgstr(NewProcCode),'"']);
8375     ProcsCopied:=true;
8376     if not FSourceChangeCache.Replace(gtNone, gtNone, InsertPos,
8377       InsertEndPos, NewProcCode) then
8378       exit(false);
8379   end;
8380   // update body signature in tree,
8381   // so that no new body is created for this definition
8382   ProcBodyNodes.RemovePointer(BodyNodeExt);
8383   BodyNodeExt.Txt:=DefNodeExt.Txt;
8384   ProcBodyNodes.Add(BodyNodeExt);
8385 end;
8386 
8387 procedure TCodeCompletionCodeTool.CheckForOverrideAndAddInheritedCode(
8388   ANodeExt: TCodeTreeNodeExtension; Indent: integer);
8389 // check for 'override' directive and add 'inherited' code to body
8390 var
8391   ProcCode, ProcCall: string;
8392   ProcNode, ClassNode: TCodeTreeNode;
8393   i: integer;
8394   InclProcCall: Boolean;
8395   Beauty: TBeautifyCodeOptions;
8396   Params: TFindDeclarationParams;
8397   Tool: TFindDeclarationTool;
8398 begin
8399   if not AddInheritedCodeToOverrideMethod then exit;
8400   {$IFDEF CTDEBUG}
8401   DebugLn('[TCodeCompletionCodeTool.CheckForOverrideAndAddInheritedCode]');
8402   {$ENDIF}
8403   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
8404   ProcNode:=ANodeExt.Node;
8405   if (ProcNode=nil) and (ANodeExt.ExtTxt3<>'') then Exit;
8406   InclProcCall:=False;
8407   if (ProcNodeHasSpecifier(ProcNode,psOVERRIDE)) then begin
8408     // Check for ancestor abstract method.
8409     Params:=TFindDeclarationParams.Create;
8410     try
8411       ClassNode:=CodeCompleteClassNode;
8412       Tool:=Self;
8413       while Tool.FindAncestorOfClass(ClassNode,Params,True) do begin
8414         Tool:=Params.NewCodeTool;
8415         ClassNode:=Params.NewNode;
8416         Params.ContextNode:=ClassNode;
8417         Params.IdentifierTool:=Self;
8418         // FirstChild skips keywords 'procedure' or 'function' or 'class procedure'
8419         Params.SetIdentifier(Self,@Src[ProcNode.FirstChild.StartPos],nil);
8420         if Tool.FindIdentifierInContext(Params) then begin
8421           // Found ancestor definition.
8422           if (Params.NewNode<>nil)
8423           and (Params.NewNode.Desc in [ctnProcedure,ctnProcedureHead]) then
8424             InclProcCall:=not Tool.ProcNodeHasSpecifier(Params.NewNode,psABSTRACT);
8425           Break;
8426         end;
8427       end;
8428     finally
8429       Params.Free;
8430     end;
8431     if InclProcCall then begin
8432       ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpAddClassname,
8433                                           phpWithVarModifiers,phpWithParameterNames,
8434                                           phpWithResultType,phpWithCallingSpecs]);
8435       ProcCall:='inherited '+ExtractProcHead(ProcNode,[phpWithoutClassName,
8436                                         phpWithParameterNames,phpWithoutParamTypes]);
8437       for i:=1 to length(ProcCall)-1 do
8438         if ProcCall[i]=';' then
8439           ProcCall[i]:=',';
8440       if ProcCall[length(ProcCall)]<>';' then
8441         ProcCall:=ProcCall+';';
rocNodenull8442       if NodeIsFunction(ProcNode) then
8443         ProcCall:=Beauty.BeautifyIdentifier('Result')+':='+ProcCall;
8444       ProcCode:=ProcCode+Beauty.LineEnd+'begin'+Beauty.LineEnd
8445                      +Beauty.GetIndentStr(Beauty.Indent)+ProcCall+Beauty.LineEnd+'end;';
8446       ProcCode:=Beauty.BeautifyProc(ProcCode,Indent,false);
8447       ANodeExt.ExtTxt3:=ProcCode;
8448     end;
8449   end;
8450 end;
8451 
UpdateProcBodySignaturesnull8452 function TCodeCompletionCodeTool.UpdateProcBodySignatures(ProcDefNodes,
8453   ProcBodyNodes: TAVLTree; ProcAttrCopyDefToBody: TProcHeadAttributes; out
8454   ProcsCopied: boolean; OnlyNode: TCodeTreeNode): boolean;
8455 { ProcDefNodes and ProcBodyNodes were created by GatherProcNodes
8456   trees of TCodeTreeNodeExtension sorted with CompareCodeTreeNodeExt
8457   NodexExt.Data has mapping to ProcBodyNodes extensions, see GuessMethodDefBodyMapping
8458 
8459   Node.Desc = ctnProcedure
8460   Node.Txt = ExtractProcHead(Node,SomeAttributes)
8461 }
8462 var
8463   BodyAVLNode: TAVLTreeNode;
8464   BodyNodeExt: TCodeTreeNodeExtension;
8465   Bodies: TFPList;
8466   i: Integer;
8467   DefNodeExt: TCodeTreeNodeExtension;
8468 begin
8469   Result:=true;
8470   ProcsCopied:=false;
8471   Bodies:=nil;
8472   try
8473     // replace body proc head(s) with def proc head(s)
8474     Bodies:=TFPList.Create;
8475     BodyAVLNode:=ProcBodyNodes.FindLowest;
8476     while BodyAVLNode<>nil do begin
8477       BodyNodeExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8478       BodyAVLNode:=ProcBodyNodes.FindSuccessor(BodyAVLNode);
8479       DefNodeExt:=TCodeTreeNodeExtension(BodyNodeExt.Data);
8480       if DefNodeExt=nil then continue;
8481       if (OnlyNode=nil) or (OnlyNode=DefNodeExt.Node)
8482       or (OnlyNode.HasAsParent(DefNodeExt.Node)) then
8483         Bodies.Add(BodyNodeExt);
8484     end;
8485     for i:=0 to Bodies.Count-1 do begin
8486       BodyNodeExt:=TCodeTreeNodeExtension(Bodies[i]);
8487       if not UpdateProcBodySignature(ProcBodyNodes, BodyNodeExt,
8488         ProcAttrCopyDefToBody, ProcsCopied,
8489         FSourceChangeCache.BeautifyCodeOptions.UpdateOtherProcSignaturesCase)
8490       then
8491         exit(false);
8492     end;
8493   finally
8494     FreeAndNil(Bodies);
8495     ClearNodeExtData(ProcBodyNodes);
8496     ClearNodeExtData(ProcDefNodes);
8497   end;
8498 end;
8499 
8500 procedure TCodeCompletionCodeTool.GuessProcDefBodyMapping(ProcDefNodes,
8501   ProcBodyNodes: TAVLTree; MapByNameOnly, MapLastOne: boolean);
8502 { ProcDefNodes and ProcBodyNodes are trees of TCodeTreeNodeExtension
8503   ProcDefNodes Data points to mapped ProcBodyNodes nodes
8504 }
8505 
8506   procedure MapBodiesAndDefsByNameAndParams;
8507   var
8508     BodyAVLNode: TAVLTreeNode;
8509     BodyNodeExt: TCodeTreeNodeExtension;
8510     DefAVLNode: TAVLTreeNode;
8511   begin
8512     BodyAVLNode:=ProcBodyNodes.FindLowest;
8513     while BodyAVLNode<>nil do begin
8514       BodyNodeExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8515       if BodyNodeExt.Data=nil then begin
8516         DefAVLNode:=ProcDefNodes.Find(BodyNodeExt);
8517         if DefAVLNode<>nil then begin
8518           // exact match => connect
8519           BodyNodeExt.Data:=DefAVLNode.Data;
8520           TCodeTreeNodeExtension(DefAVLNode.Data).Data:=BodyNodeExt;
8521         end else begin
8522           {$IFDEF VerboseUpdateProcBodySignatures}
8523           debugln(['  MapBodiesAndDefsByNameAndParams has no exact match definition: '+BodyNodeExt.Txt]);
8524           {$ENDIF}
8525         end;
8526       end;
8527       BodyAVLNode:=ProcBodyNodes.FindSuccessor(BodyAVLNode);
8528     end;
8529   end;
8530 
CreateNameTreenull8531   function CreateNameTree(NodeExtTree: TAVLTree; SkipNodesWithData: boolean): TAVLTree;
8532   var
8533     AVLNodeExt: TAVLTreeNode;
8534     ProcNode: TCodeTreeNode;
8535     NodeExt: TCodeTreeNodeExtension;
8536     NewNodeExt: TCodeTreeNodeExtension;
8537   begin
8538     Result:=nil;
8539     if NodeExtTree=nil then exit;
8540     AVLNodeExt:=NodeExtTree.FindLowest;
8541     while AVLNodeExt<>nil do begin
8542       NodeExt:=TCodeTreeNodeExtension(AVLNodeExt.Data);
8543       AVLNodeExt:=NodeExtTree.FindSuccessor(AVLNodeExt);
8544       if (not SkipNodesWithData) or (NodeExt.Data=nil)
8545       or (ProcNodeHasSpecifier(NodeExt.Node,psEXTERNAL)) then begin
8546         {$IFDEF VerboseUpdateProcBodySignatures}
8547         if NodeExtTree=ProcBodyNodes then
8548           debugln(['CreateNameTree body without corresponding def: ',NodeExt.Txt])
8549         else
8550           debugln(['CreateNameTree def without corresponding body: ',NodeExt.Txt]);
8551         {$ENDIF}
8552         ProcNode:=NodeExt.Node;
8553         NewNodeExt:=TCodeTreeNodeExtension.Create;
8554         NewNodeExt.Node:=ProcNode;
8555         NewNodeExt.Txt:=ExtractProcName(ProcNode,[phpWithoutClassName]);
8556         NewNodeExt.Data:=NodeExt;
8557         NewNodeExt.Flags:=Integer(ExtractProcedureGroup(ProcNode));
8558         if Result=nil then
8559           Result:=TAVLTree.Create(@CompareCodeTreeNodeExtMethodHeaders);
8560         Result.Add(NewNodeExt);
8561       end;
8562     end;
8563   end;
8564 
8565   procedure MapBodiesAndDefsByName;
8566   var
8567     BodyNodesByName, DefNodesByName: TAVLTree;
8568     BodyAVLNode: TAVLTreeNode;
8569     LastBodySameName: TAVLTreeNode;
8570     FirstDefSameName: TAVLTreeNode;
8571     LastDefSameName: TAVLTreeNode;
8572     ProcBodyExt: TCodeTreeNodeExtension;
8573     DefExt: TCodeTreeNodeExtension;
8574     DefNameExt: TCodeTreeNodeExtension;
8575     ProcBodyByNameExt: TCodeTreeNodeExtension;
8576   begin
8577     BodyNodesByName:=nil;
8578     DefNodesByName:=nil;
8579     try
8580       // create a tree of proc names and nodes, that were not yet mapped
8581       // one for the bodies ...
8582       BodyNodesByName:=CreateNameTree(ProcBodyNodes,true);
8583       if BodyNodesByName=nil then exit;
8584       // ... and one for the definitions
8585       DefNodesByName:=CreateNameTree(ProcDefNodes,true);
8586       if DefNodesByName=nil then exit;
8587       // check each body if it can be mapped bijective by name
8588       BodyAVLNode:=BodyNodesByName.FindLowest;
8589       while BodyAVLNode<>nil do begin
8590         ProcBodyByNameExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8591         ProcBodyExt:=TCodeTreeNodeExtension(ProcBodyByNameExt.Data);
8592         LastBodySameName:=BodyNodesByName.FindRightMostSameKey(BodyAVLNode);
8593         if LastBodySameName<>BodyAVLNode then begin
8594           // multiple bodies with same name => skip
8595           {$IFDEF VerboseUpdateProcBodySignatures}
8596           debugln(['  MapBodiesAndDefsByName multiple definitionless bodies with same name:']);
8597           repeat
8598             ProcBodyByNameExt:=TCodeTreeNodeExtension(BodyAVLNode.Data);
8599             ProcBodyExt:=TCodeTreeNodeExtension(ProcBodyByNameExt.Data);
8600             debugln(['    '+ProcBodyExt.Txt]);
8601             BodyAVLNode:=BodyNodesByName.FindSuccessor(BodyAVLNode);
8602           until BodyAVLNode<>LastBodySameName;
8603           {$ENDIF}
8604           BodyAVLNode:=LastBodySameName;
8605         end else begin
8606           // there is only one body with this name that has no exact definition
8607           // => search in definitions
8608           FirstDefSameName:=DefNodesByName.FindLeftMost(ProcBodyByNameExt);
8609           if FirstDefSameName<>nil then begin
8610             // there is at least one definition with this name and without a body
8611             DefNameExt:=TCodeTreeNodeExtension(FirstDefSameName.Data);
8612             DefExt:=TCodeTreeNodeExtension(DefNameExt.Data);
8613             LastDefSameName:=DefNodesByName.FindRightMostSameKey(FirstDefSameName);
8614             if LastDefSameName=FirstDefSameName then begin
8615               // there is exactly one definition with this name and without a body
8616               // => connect
8617               ProcBodyExt.Data:=DefExt;
8618               DefExt.Data:=ProcBodyExt;
8619             end else begin
8620               {$IFDEF VerboseUpdateProcBodySignatures}
8621               debugln(['  MapBodiesAndDefsByName multiple bodyless definitions with same name: ']);
8622               repeat
8623                 DefNameExt:=TCodeTreeNodeExtension(FirstDefSameName.Data);
8624                 DefExt:=TCodeTreeNodeExtension(DefNameExt.Data);
8625                 debugln(['    '+DefExt.Txt]);
8626                 FirstDefSameName:=DefNodesByName.FindSuccessor(FirstDefSameName);
8627               until FirstDefSameName=LastDefSameName;
8628               {$ENDIF}
8629             end;
8630           end;
8631         end;
8632         BodyAVLNode:=BodyNodesByName.FindSuccessor(BodyAVLNode);
8633       end;
8634     finally
8635       if BodyNodesByName<>nil then begin
8636         BodyNodesByName.FreeAndClear;
8637         BodyNodesByName.Free;
8638       end;
8639       if DefNodesByName<>nil then begin
8640         DefNodesByName.FreeAndClear;
8641         DefNodesByName.Free;
8642       end;
8643     end;
8644   end;
8645 
GetNodeExtWithoutDatanull8646   function GetNodeExtWithoutData(Tree: TAVLTree; out Count: integer
8647     ): TCodeTreeNodeExtension;
8648   var
8649     AVLNode: TAVLTreeNode;
8650     NodeExt: TCodeTreeNodeExtension;
8651   begin
8652     Result:=nil;
8653     Count:=0;
8654     AVLNode:=Tree.FindLowest;
8655     while AVLNode<>nil do begin
8656       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
8657       if NodeExt.Data=nil then begin
8658         inc(Count);
8659         Result:=NodeExt;
8660       end;
8661       AVLNode:=Tree.FindSuccessor(AVLNode);
8662     end;
8663   end;
8664 
8665   procedure MapLastBodyAndDef;
8666   var
8667     BodyNodeExt: TCodeTreeNodeExtension;
8668     Cnt: integer;
8669     DefNodeExt: TCodeTreeNodeExtension;
8670   begin
8671     BodyNodeExt:=GetNodeExtWithoutData(ProcBodyNodes,Cnt);
8672     if Cnt>1 then debugln(['Note: TCodeCompletionCodeTool.UpdateProcBodySignatures.MapLastBodyAndDef multiple bodies which can not be mapped to definitions']);
8673     if Cnt<>1 then exit;
8674     DefNodeExt:=GetNodeExtWithoutData(ProcDefNodes,Cnt);
8675     if Cnt>1 then debugln(['Note: TCodeCompletionCodeTool.UpdateProcBodySignatures.MapLastBodyAndDef multiple definitions which can not be mapped to bodies']);
8676     if Cnt<>1 then exit;
8677     BodyNodeExt.Data:=DefNodeExt;
8678     DefNodeExt.Data:=BodyNodeExt;
8679   end;
8680 
8681 begin
8682   {$IFDEF VerboseUpdateProcBodySignatures}
8683   debugln(['TCodeCompletionCodeTool.GuessProcDefBodyMapping',
8684     ' ProcDefNodes=',ProcDefNodes.Count,
8685     ' ProcBodyNodes=',ProcBodyNodes.Count,
8686     ' MapByNameOnly=',MapByNameOnly,
8687     ' MapLastOne=',MapLastOne
8688     ]);
8689   {$ENDIF}
8690   ClearNodeExtData(ProcBodyNodes);
8691   ClearNodeExtData(ProcDefNodes);
8692   MapBodiesAndDefsByNameAndParams; // first: map all exact matches between bodies and defs
8693   if MapByNameOnly then
8694     MapBodiesAndDefsByName; // second: map remaining by name without params
8695   if MapLastOne then
8696     MapLastBodyAndDef; // last: map if there is exactly one unmatching body and def
8697 end;
8698 
TCodeCompletionCodeTool.GatherClassProcDefinitionsnull8699 function TCodeCompletionCodeTool.GatherClassProcDefinitions(
8700   ClassNode: TCodeTreeNode; RemoveAbstracts: boolean): TAVLTree;
8701 var
8702   AnAVLNode: TAVLTreeNode;
8703   NextAVLNode: TAVLTreeNode;
8704   ANodeExt: TCodeTreeNodeExtension;
8705   ANode: TCodeTreeNode;
8706 begin
8707   Result:=GatherProcNodes(ClassNode.FirstChild,
8708              [phpInUpperCase,phpAddClassName],ExtractClassName(ClassNode,true));
8709   if RemoveAbstracts then begin
8710     AnAVLNode:=Result.FindLowest;
8711     while AnAVLNode<>nil do begin
8712       NextAVLNode:=Result.FindSuccessor(AnAVLNode);
8713       ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
8714       ANode:=ANodeExt.Node;
8715       if (ANode<>nil) and (ANode.Desc=ctnProcedure)
8716       and ProcNodeHasSpecifier(ANode,psABSTRACT) then begin
8717         Result.Delete(AnAVLNode);
8718         ANodeExt.Free;
8719       end;
8720       AnAVLNode:=NextAVLNode;
8721     end;
8722   end;
8723 end;
8724 
GatherClassProcBodiesnull8725 function TCodeCompletionCodeTool.GatherClassProcBodies(ClassNode: TCodeTreeNode
8726   ): TAVLTree;
8727 var
8728   TypeSectionNode: TCodeTreeNode;
8729 begin
8730   TypeSectionNode:=ClassNode.GetTopMostNodeOfType(ctnTypeSection);
8731   Result:=GatherProcNodes(TypeSectionNode,
8732                       [phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
8733                        ExtractClassName(ClassNode,true,true,false));
8734 end;
8735 
TCodeCompletionCodeTool.CreateMissingClassProcBodiesnull8736 function TCodeCompletionCodeTool.CreateMissingClassProcBodies(
8737   UpdateSignatures: boolean): boolean;
8738 const
8739   ProcAttrDefToBody = [phpWithStart,
8740                phpAddClassname,phpWithVarModifiers,
8741                phpWithParameterNames,phpWithResultType,
8742                phpWithCallingSpecs,phpWithAssembler];
8743 var
8744   TheClassName: string;
8745   Beauty: TBeautifyCodeOptions;
8746 
8747   procedure InsertProcBody(ANodeExt: TCodeTreeNodeExtension;
8748     InsertPos, Indent: integer);
8749   var ProcCode: string;
8750   begin
8751     if ANodeExt.ExtTxt3<>'' then
8752       ProcCode:=ANodeExt.ExtTxt3
8753     else
8754       ProcCode:=ANodeExt.ExtTxt1;
8755     ProcCode:=Beauty.AddClassAndNameToProc(ProcCode,TheClassName,'');
8756     {$IFDEF CTDEBUG}
8757     DebugLn('CreateMissingClassProcBodies InsertProcBody ',TheClassName,' "',ProcCode,'"');
8758     {$ENDIF}
8759     ProcCode:=Beauty.BeautifyProc(ProcCode,Indent,ANodeExt.ExtTxt3='');
8760     FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,ProcCode);
8761     if FJumpToProcHead.Name='' then begin
8762       // remember one proc body to jump to after the completion
8763       FJumpToProcHead.Name:=ANodeExt.Txt;
8764       FJumpToProcHead.Group:=TPascalMethodGroup(ANodeExt.Flags);
8765       FJumpToProcHead.ResultType:=ANodeExt.ExtTxt4;
8766       if System.Pos('.',FJumpToProcHead.Name)<1 then
8767         FJumpToProcHead.Name:=TheClassName+'.'+FJumpToProcHead.Name;
8768       if FJumpToProcHead.Name[length(FJumpToProcHead.Name)]<>';' then
8769         FJumpToProcHead.Name:=FJumpToProcHead.Name+';';
8770       {$IFDEF CTDEBUG}
8771       DebugLn('CreateMissingClassProcBodies FJumpToProcHead.Name="',FJumpToProcHead.Name,'"');
8772       {$ENDIF}
8773     end;
8774   end;
8775 
8776   procedure CreateCodeForMissingProcBody(TheNodeExt: TCodeTreeNodeExtension;
8777     Indent: integer);
8778   var
8779     ANode: TCodeTreeNode;
8780     ProcCode: string;
8781   begin
8782     CheckForOverrideAndAddInheritedCode(TheNodeExt,Indent);
8783     if (TheNodeExt.ExtTxt1='') and (TheNodeExt.ExtTxt3='') then begin
8784       ANode:=TheNodeExt.Node;
8785       if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
8786         ProcCode:=ExtractProcHead(ANode,ProcAttrDefToBody);
8787         //debugln(['CreateCodeForMissingProcBody Definition="',ProcCode,'"']);
8788         TheNodeExt.ExtTxt3:=Beauty.BeautifyProc(ProcCode,Indent,true);
8789         //debugln(['CreateCodeForMissingProcBody Beautified="',TheNodeExt.ExtTxt3,'"']);
8790       end;
8791     end;
8792   end;
8793 
8794 var
8795   ProcBodyNodes, ClassProcs: TAVLTree;
8796   ANodeExt, ANodeExt2: TCodeTreeNodeExtension;
8797   ExistingNode, MissingNode, AnAVLNode, NextAVLNode,
8798   NearestAVLNode: TAVLTreeNode;
8799   cmp, MissingNodePosition: integer;
8800   FirstExistingProcBody, LastExistingProcBody, ImplementationNode,
8801   ANode, ANode2: TCodeTreeNode;
8802   ClassStartComment, s: string;
8803   Caret1, Caret2: TCodeXYPosition;
8804   MethodInsertPolicy: TMethodInsertPolicy;
8805   NearestNodeValid: boolean;
8806 
8807   procedure FindTopMostAndBottomMostProcBodies;
8808   begin
8809     ExistingNode:=ProcBodyNodes.FindLowest;
8810     if ExistingNode<>nil then
8811       LastExistingProcBody:=TCodeTreeNodeExtension(ExistingNode.Data).Node
8812     else
8813       LastExistingProcBody:=nil;
8814     FirstExistingProcBody:=LastExistingProcBody;
8815     while ExistingNode<>nil do begin
8816       ANode:=TCodeTreeNodeExtension(ExistingNode.Data).Node;
8817       if ANode.StartPos<FirstExistingProcBody.StartPos then
8818         FirstExistingProcBody:=ANode;
8819       if ANode.StartPos>LastExistingProcBody.StartPos then
8820         LastExistingProcBody:=ANode;
8821       //DebugLn(['FindTopMostAndBottomMostProcBodies ',TCodeTreeNodeExtension(ExistingNode.Data).Txt]);
8822       ExistingNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
8823     end;
8824   end;
8825 
8826   procedure CheckForDoubleDefinedMethods;
8827   begin
8828     AnAVLNode:=ClassProcs.FindLowest;
8829     while AnAVLNode<>nil do begin
8830       NextAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
8831       if NextAVLNode<>nil then begin
8832         ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
8833         ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
8834         if CompareCodeTreeNodeExtMethodHeaders(ANodeExt, ANodeExt2) = 0 then
8835         begin
8836           // proc redefined -> error
8837           if ANodeExt.Node.StartPos>ANodeExt2.Node.StartPos then begin
8838             ANode:=ANodeExt.Node;
8839             ANode2:=ANodeExt2.Node;
8840           end else begin
8841             ANode:=ANodeExt2.Node;
8842             ANode2:=ANodeExt.Node;
8843           end;
8844           debugln(['CheckForDoubleDefinedMethods redefined']);
8845           debugln('  1. ',ANodeExt.Txt,' ',CleanPosToStr(ANodeExt.Node.StartPos));
8846           debugln('  2. ',ANodeExt2.Txt,' ',CleanPosToStr(ANodeExt2.Node.StartPos));
8847           CleanPosToCaret(ANode.FirstChild.StartPos,Caret1);
8848           CleanPosToCaret(ANode2.FirstChild.StartPos,Caret2);
8849           s:=IntToStr(Caret2.Y)+','+IntToStr(Caret2.X);
8850           if Caret1.Code<>Caret2.Code then
8851             s:=s+' in '+CreateRelativePath(Caret2.Code.Filename,ExtractFilePath(Caret1.Code.Filename));
8852           MoveCursorToNodeStart(ANode.FirstChild);
8853           RaiseException(20170421201808,'procedure redefined (first at '+s+')');
8854         end;
8855       end;
8856       AnAVLNode:=NextAVLNode;
8857     end;
8858   end;
8859 
8860   procedure FindInsertPointForNewClass(out InsertPos, Indent: LongInt);
8861 
8862     procedure SetIndentAndInsertPos(Node: TCodeTreeNode; Behind: boolean);
8863     begin
8864       Indent:=Beauty.GetLineIndent(Src,Node.StartPos);
8865       if Behind then
8866         InsertPos:=FindLineEndOrCodeAfterPosition(Node.EndPos)
8867       else
8868         InsertPos:=FindLineEndOrCodeInFrontOfPosition(Node.StartPos);
8869     end;
8870 
8871   var
8872     StartSearchProc: TCodeTreeNode;
8873     NearestProcNode: TCodeTreeNode;
8874     UnitInterfaceNode: TCodeTreeNode;
8875   begin
8876     InsertPos:=0;
8877     Indent:=0;
8878     ImplementationNode:=FindImplementationNode;
8879     StartSearchProc:=nil;
8880     UnitInterfaceNode:=FindInterfaceNode;
8881     if (UnitInterfaceNode<>nil)
8882     and CodeCompleteClassNode.HasAsParent(UnitInterfaceNode) then begin
8883       // class is in interface section
8884       // -> insert at the end of the implementation section
8885       if ImplementationNode=nil then begin
8886         // create implementation section
8887         InsertPos:=UnitInterfaceNode.EndPos;
8888         Indent:=Beauty.GetLineIndent(Src,UnitInterfaceNode.StartPos);
8889         if not CodeCompleteSrcChgCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
8890           CodeCompleteSrcChgCache.BeautifyCodeOptions.BeautifyKeyWord('implementation'))
8891         then begin
8892           MoveCursorToCleanPos(InsertPos);
8893           RaiseException(20170421201812,'unable to insert implementation section (read only?)');
8894         end;
8895         exit;
8896       end else if (ImplementationNode.FirstChild=nil)
8897       or (ImplementationNode.FirstChild.Desc=ctnBeginBlock) then begin
8898         // implementation is empty
8899         Indent:=Beauty.GetLineIndent(Src,ImplementationNode.StartPos);
8900         if ImplementationNode.FirstChild<>nil then
8901           InsertPos:=ImplementationNode.FirstChild.StartPos
8902         else
8903           InsertPos:=ImplementationNode.EndPos;
8904         exit;
8905       end;
8906       StartSearchProc:=ImplementationNode.FirstChild;
8907     end else begin
8908       // class is not in interface section
8909       StartSearchProc:=CodeCompleteClassNode.GetTopMostNodeOfType(ctnTypeSection);
8910     end;
8911     case Beauty.ForwardProcBodyInsertPolicy of
8912     fpipInFrontOfMethods:
8913       begin
8914         // Try to insert new proc in front of existing methods
8915 
8916         // find first method
8917         NearestProcNode:=StartSearchProc;
8918         while (NearestProcNode<>nil) and (NearestProcNode.Desc<>ctnBeginBlock)
8919         and (not NodeIsMethodBody(NearestProcNode)) do
8920           NearestProcNode:=NearestProcNode.NextBrother;
8921         if NearestProcNode<>nil then begin
8922           // the comments in front of the first method probably belong to the class
8923           // Therefore insert behind the node in front of the first method
8924           Indent:=Beauty.GetLineIndent(Src,NearestProcNode.StartPos);
8925           if NearestProcNode.PriorBrother<>nil then begin
8926             InsertPos:=FindLineEndOrCodeAfterPosition(NearestProcNode.PriorBrother.EndPos);
8927           end else begin
8928             InsertPos:=NearestProcNode.Parent.StartPos;
8929             while (InsertPos<=NearestProcNode.StartPos)
8930             and (not IsSpaceChar[Src[InsertPos]]) do
8931               inc(InsertPos);
8932           end;
8933           InsertPos:=SkipResourceDirective(InsertPos);
8934           exit;
8935         end;
8936       end;
8937     fpipBehindMethods:
8938       begin
8939         // Try to insert new proc behind existing methods
8940 
8941         // find last method (go to last brother and search backwards)
8942         if (StartSearchProc<>nil) and (StartSearchProc.Parent<>nil) then
8943           NearestProcNode:=StartSearchProc.Parent.LastChild
8944         else
8945           NearestProcNode:=nil;
8946         while (NearestProcNode<>nil) and (not NodeIsMethodBody(NearestProcNode)) do
8947           NearestProcNode:=NearestProcNode.PriorBrother;
8948         if NearestProcNode<>nil then begin
8949           SetIndentAndInsertPos(NearestProcNode,NearestProcNode.Desc<>ctnBeginBlock);
8950           InsertPos:=SkipResourceDirective(InsertPos);
8951           exit;
8952         end;
8953       end;
8954     end;
8955 
8956     // Default position: Insert behind last node
8957     if (StartSearchProc<>nil)
8958     and (StartSearchProc.Parent<>nil) then begin
8959       NearestProcNode:=StartSearchProc.Parent.LastChild;
8960       if NearestProcNode.Desc=ctnBeginBlock then
8961         NearestProcNode:=NearestProcNode.PriorBrother;
8962     end;
8963     if NearestProcNode<>nil then begin
8964       Indent:=0;
8965       SetIndentAndInsertPos(NearestProcNode,true);
8966       InsertPos:=SkipResourceDirective(InsertPos);
8967       exit;
8968     end;
8969 
8970     RaiseException(20170421201815,'TCodeCompletionCodeTool.CreateMissingClassProcBodies.FindInsertPointForNewClass '
8971      +' Internal Error: no insert position found');
8972   end;
8973 
8974   procedure InsertClassMethodsComment(InsertPos, Indent: integer);
8975   var
8976     CommentStartPos: integer;
8977     CommentEndPos: integer;
8978   begin
8979     // insert class comment
8980     if ClassProcs.Count=0 then exit;
8981     if not Beauty.ClassImplementationComments
8982     then
8983       exit;
8984     // find the start of the class (the position in front of the class name)
8985     // check if there is already a comment in front
8986     if FindClassMethodsComment(InsertPos,CommentStartPos,CommentEndPos) then begin
8987       // comment already exists
8988       exit;
8989     end;
8990     ClassStartComment:=Beauty.GetIndentStr(Indent)
8991                        +'{ '+ExtractClassName(CodeCompleteClassNode,false)+' }';
8992     FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
8993                                ClassStartComment);
8994   end;
8995 
8996 var
8997   InsertPos: integer;
8998   Indent: integer;
8999   ProcsCopied: boolean;
9000   OnlyNode: TCodeTreeNode;
9001 begin
9002   {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9003   DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies Gather existing method bodies ... ');
9004   {$ENDIF}
9005   if CodeCompleteClassNode.Desc in AllClassInterfaces then begin
9006     // interfaces have no implementations
9007     {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9008     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies interface ',CodeCompleteClassNode.DescAsString]);
9009     {$ENDIF}
9010     exit(true);
9011   end;
9012   if FindClassExternalNode(CodeCompleteClassNode)<>nil then begin
9013     // external class has no implementations
9014     {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9015     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies external ',CodeCompleteClassNode.DescAsString]);
9016     {$ENDIF}
9017     exit(true);
9018   end;
9019 
9020   Result:=false;
9021   Beauty:=FSourceChangeCache.BeautifyCodeOptions;
9022   MethodInsertPolicy:=Beauty.MethodInsertPolicy;
9023   // gather existing class proc bodies
9024   ClassProcs:=nil;
9025   ProcBodyNodes:=nil;
9026   try
9027     {$IFDEF VerboseCreateMissingClassProcBodies}
9028     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies get class procs of ',CodeCompleteClassNode.DescAsString]);
9029     {$ENDIF}
9030     ClassProcs:=GatherClassProcDefinitions(CodeCompleteClassNode,true);
9031     {$IFDEF VerboseCreateMissingClassProcBodies}
9032     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies get bodies of ',CodeCompleteClassNode.DescAsString]);
9033     {$ENDIF}
9034     ProcBodyNodes:=GatherClassProcBodies(CodeCompleteClassNode);
9035 
9036     {$IFDEF VerboseCreateMissingClassProcBodies}
9037     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ClassProcs=',ClassProcs.Count]);
9038     AnAVLNode:=ClassProcs.FindLowest;
9039     while AnAVLNode<>nil do begin
9040       DebugLn(' Gathered ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9041       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9042     end;
9043     debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ProcBodyNodes=',ProcBodyNodes.Count]);
9044     AnAVLNode:=ProcBodyNodes.FindLowest;
9045     while AnAVLNode<>nil do begin
9046       DebugLn(' Gathered ProcBody ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9047       AnAVLNode:=ProcBodyNodes.FindSuccessor(AnAVLNode);
9048     end;
9049     {$ENDIF}
9050 
9051     // find topmost and bottommost proc body
9052     FindTopMostAndBottomMostProcBodies;
9053 
9054     {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9055     DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies Gather existing method declarations ... ');
9056     {$ENDIF}
9057     TheClassName:=ExtractClassName(CodeCompleteClassNode,false,true,Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE]);
9058 
9059     // check for double defined methods in ClassProcs
9060     CheckForDoubleDefinedMethods;
9061 
9062     // check for changed procs
9063     if UpdateSignatures then begin
9064       GuessProcDefBodyMapping(ClassProcs,ProcBodyNodes,true,true);
9065       if Beauty.UpdateAllMethodSignatures then
9066         OnlyNode:=nil
9067       else
9068         OnlyNode:=FCompletingCursorNode;
9069       {$IFDEF VerboseCreateMissingClassProcBodies}
9070       debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies Beauty.UpdateAllMethodSignatures=',Beauty.UpdateAllMethodSignatures,' ',OnlyNode<>nil]);
9071       {$ENDIF}
9072       if not UpdateProcBodySignatures(ClassProcs,ProcBodyNodes,ProcAttrDefToBody,
9073         ProcsCopied,OnlyNode)
9074       then exit;
9075     end;
9076 
9077     // there are new methods
9078 
9079     CurNode:=FirstExistingProcBody;
9080 
9081     {$IFDEF VerboseCreateMissingClassProcBodies}
9082     AnAVLNode:=ClassProcs.FindLowest;
9083     while AnAVLNode<>nil do begin
9084       DebugLn(' SignaturesUpdated ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9085       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9086     end;
9087     {$ENDIF}
9088 
9089     AddNewPropertyAccessMethodsToClassProcs(ClassProcs,TheClassName);
9090 
9091     {$IFDEF VerboseCreateMissingClassProcBodies}
9092     AnAVLNode:=ClassProcs.FindLowest;
9093     while AnAVLNode<>nil do begin
9094       DebugLn(' AfterPropsCompleted ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
9095       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9096     end;
9097     {$ENDIF}
9098 
9099     if MethodInsertPolicy=mipClassOrder then begin
9100       // insert in ClassOrder -> get a definition position for every method
9101       AnAVLNode:=ClassProcs.FindLowest;
9102       while AnAVLNode<>nil do begin
9103         ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
9104         if ANodeExt.Position<1 then
9105           // position not set => this proc was already there => there is a node
9106           ANodeExt.Position:=ANodeExt.Node.StartPos;
9107         // find corresponding proc body
9108         NextAVLNode:=ProcBodyNodes.Find(ANodeExt);
9109         if NextAVLNode<>nil then begin
9110           // NextAVLNode.Data is the TCodeTreeNodeExtension for the method body
9111           // (note 1)
9112           ANodeExt.Data:=NextAVLNode.Data;
9113         end;
9114         AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9115       end;
9116       // sort the method definitions with the definition position
9117       ClassProcs.OnCompare:=@CompareCodeTreeNodeExtWithPos;
9118     end;
9119 
9120     {$IFDEF VerboseCreateMissingClassProcBodies}
9121     AnAVLNode:=ClassProcs.FindLowest;
9122     while AnAVLNode<>nil do begin
9123       DebugLn(' BeforeAddMissing ProcDef "',TCodeTreeNodeExtension(AnAVLNode.Data).Txt,'"');
9124       AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
9125     end;
9126     AnAVLNode:=ProcBodyNodes.FindLowest;
9127     while AnAVLNode<>nil do begin
9128       DebugLn(' BeforeAddMissing ProcBody "',TCodeTreeNodeExtension(AnAVLNode.Data).Txt,'"');
9129       AnAVLNode:=ProcBodyNodes.FindSuccessor(AnAVLNode);
9130     end;
9131     {$ENDIF}
9132 
9133     // search for missing proc bodies
9134     if (ProcBodyNodes.Count=0) then begin
9135       // there were no old proc bodies of the class -> start class
9136       {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9137       DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies Starting class in implementation ');
9138       {$ENDIF}
9139       FindInsertPointForNewClass(InsertPos,Indent);
9140       {$IFDEF VerboseCreateMissingClassProcBodies}
9141       debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies Indent=',Indent,' InsertPos=',dbgstr(copy(Src,InsertPos-10,10)),'|',dbgstr(copy(Src,InsertPos,10))]);
9142       {$ENDIF}
9143       InsertClassMethodsComment(InsertPos,Indent);
9144 
9145       // insert all proc bodies
9146       MissingNode:=ClassProcs.FindHighest;
9147       while (MissingNode<>nil) do begin
9148         ANodeExt:=TCodeTreeNodeExtension(MissingNode.Data);
9149         MissingNode:=ClassProcs.FindPrecessor(MissingNode);
9150         if ProcNodeHasSpecifier(ANodeExt.Node,psEXTERNAL) then continue;
9151         CreateCodeForMissingProcBody(ANodeExt,Indent);
9152         InsertProcBody(ANodeExt,InsertPos,Indent);
9153       end;
9154 
9155     end else begin
9156       // there were old class procs already
9157       // -> search a good Insert Position behind or in front of
9158       //    another proc body of this class
9159       {$IF defined(CTDEBUG) or defined(VerboseCreateMissingClassProcBodies)}
9160       DebugLn('TCodeCompletionCodeTool.CreateMissingClassProcBodies  Insert missing bodies between existing ... ClassProcs.Count=',dbgs(ClassProcs.Count));
9161       {$ENDIF}
9162 
9163       // set default insert position
9164       Indent:=Beauty.GetLineIndent(Src,LastExistingProcBody.StartPos);
9165       InsertPos:=FindLineEndOrCodeAfterPosition(LastExistingProcBody.EndPos);
9166 
9167       // check for all defined class methods (MissingNode), if there is a body
9168       MissingNode:=ClassProcs.FindHighest;
9169       NearestNodeValid:=false;
9170       while (MissingNode<>nil) do begin
9171         ANodeExt:=TCodeTreeNodeExtension(MissingNode.Data);
9172         MissingNode:=ClassProcs.FindPrecessor(MissingNode);
9173         ExistingNode:=ProcBodyNodes.Find(ANodeExt);
9174         {$IFDEF VerboseCreateMissingClassProcBodies}
9175         DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Txt,' ExistingNode=',ExistingNode<>nil]);
9176         {$ENDIF}
9177         if (ExistingNode=nil) and (not ProcNodeHasSpecifier(ANodeExt.Node,psEXTERNAL))
9178         then begin
9179           {$IFDEF VerboseCreateMissingClassProcBodies}
9180           //generates AV:
9181           //DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Txt,' ExistingNode=',TCodeTreeNodeExtension(ExistingNode.Data).Txt]);
9182           {$ENDIF}
9183           // MissingNode does not have a body -> insert proc body
9184           case MethodInsertPolicy of
9185           mipAlphabetically:
9186             begin
9187               // search alphabetically nearest proc body
9188               ExistingNode:=ProcBodyNodes.FindNearest(ANodeExt);
9189               cmp:=CompareCodeTreeNodeExtMethodHeaders(ExistingNode.Data,ANodeExt);
9190               if (cmp<0) then begin
9191                 AnAVLNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
9192                 if AnAVLNode<>nil then begin
9193                   ExistingNode:=AnAVLNode;
9194                   cmp:=1;
9195                 end;
9196               end;
9197               ANodeExt2:=TCodeTreeNodeExtension(ExistingNode.Data);
9198               ANode:=ANodeExt2.Node;
9199               Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
9200               if cmp>0 then begin
9201                 // insert behind ExistingNode
9202                 InsertPos:=FindLineEndOrCodeAfterPosition(ANode.EndPos);
9203               end else begin
9204                 // insert in front of ExistingNode
9205                 InsertPos:=FindLineEndOrCodeInFrontOfPosition(ANode.StartPos);
9206               end;
9207             end;
9208 
9209           mipClassOrder:
9210             begin
9211               // search definition-position nearest proc node
9212               MissingNodePosition:=ANodeExt.Position;
9213               if not NearestNodeValid then begin
9214                 // search NearestAVLNode method with body in front of MissingNode
9215                 // and NextAVLNode method with body behind MissingNode
9216                 NearestAVLNode:=nil;
9217                 NextAVLNode:=ClassProcs.FindHighest;
9218                 NearestNodeValid:=true;
9219               end;
9220               while (NextAVLNode<>nil) do begin
9221                 ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
9222                 if ANodeExt2.Data<>nil then begin
9223                   // method has body
9224                   if ANodeExt2.Position>MissingNodePosition then
9225                     break;
9226                   NearestAVLNode:=NextAVLNode;
9227                 end;
9228                 NextAVLNode:=ClassProcs.FindPrecessor(NextAVLNode);
9229               end;
9230               if NearestAVLNode<>nil then begin
9231                 // there is a NearestAVLNode in front -> insert behind body
9232                 ANodeExt2:=TCodeTreeNodeExtension(NearestAVLNode.Data);
9233                 // see above (note 1) for ANodeExt2.Data
9234                 ANode:=TCodeTreeNodeExtension(ANodeExt2.Data).Node;
9235                 Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
9236                 InsertPos:=FindLineEndOrCodeAfterPosition(ANode.EndPos);
9237               end else if NextAVLNode<>nil then begin
9238                 // there is a NextAVLNode behind -> insert in front of body
9239                 ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
9240                 // see above (note 1) for ANodeExt2.Data
9241                 ANode:=TCodeTreeNodeExtension(ANodeExt2.Data).Node;
9242                 Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
9243                 InsertPos:=FindLineEndOrCodeInFrontOfPosition(ANode.StartPos);
9244               end;
9245             end;
9246           end;
9247           CreateCodeForMissingProcBody(ANodeExt,Indent);
9248           InsertProcBody(ANodeExt,InsertPos,0);
9249         end;
9250       end;
9251     end;
9252     Result:=true;
9253   finally
9254     DisposeAVLTree(ClassProcs);
9255     DisposeAVLTree(ProcBodyNodes);
9256   end;
9257 end;
9258 
ApplyChangesAndJumpToFirstNewProcnull9259 function TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc(
9260   CleanPos: integer; OldTopLine: integer; AddMissingProcBodies: boolean; out
9261   NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine,
9262   BlockBottomLine: integer): boolean;
9263 var
9264   OldCodeXYPos: TCodeXYPosition;
9265   OldCodePos: TCodePosition;
9266   CursorNode: TCodeTreeNode;
9267   CurClassName: String;
9268   ProcNode: TCodeTreeNode;
9269 begin
9270   Result:=false;
9271 
9272   try
9273     // extend class declaration
9274     if not InsertAllNewClassParts then
9275       RaiseException(20170421201817,ctsErrorDuringInsertingNewClassParts);
9276 
9277     // create missing method bodies
9278     if AddMissingProcBodies and (not CreateMissingClassProcBodies(true)) then
9279       RaiseException(20170421201819,ctsErrorDuringCreationOfNewProcBodies);
9280 
9281     CurClassName:=ExtractClassName(CodeCompleteClassNode,false);
9282 
9283     // apply the changes and jump to first new proc body
9284     if not CleanPosToCodePos(CleanPos,OldCodePos) then
9285       RaiseException(20170421201822,'TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCodePos');
9286     if not CleanPosToCaret(CleanPos,OldCodeXYPos) then
9287       RaiseException(20170421201826,'TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCaret');
9288     if not FSourceChangeCache.Apply then
9289       RaiseException(20170421201828,ctsUnableToApplyChanges);
9290 
9291   finally
9292     FreeClassInsertionList;
9293   end;
9294 
9295   if FJumpToProcHead.Name<>'' then begin
9296     {$IFDEF CTDEBUG}
9297     DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Jump to new proc body ... "',FJumpToProcHead.Name,'"');
9298     {$ENDIF}
9299     // there was a new proc body
9300     // -> find it and jump to
9301 
9302     // reparse code
9303     BuildTreeAndGetCleanPos(OldCodeXYPos,CleanPos);
9304     // find CodeTreeNode at cursor
9305     CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
9306     // due to insertions in front of the class, the cursor position could
9307     // have changed
9308     if CursorNode<>nil then
9309       CursorNode:=CursorNode.GetTopMostNodeOfType(ctnTypeSection);
9310     FCodeCompleteClassNode:=FindClassNode(CursorNode,CurClassName,true,false);
9311     if CodeCompleteClassNode=nil then
9312       RaiseException(20170421201833,'oops, I lost your class');
9313     ProcNode:=FindProcNode(CursorNode,FJumpToProcHead,[phpInUpperCase,phpIgnoreForwards]);
9314     if ProcNode=nil then begin
9315       debugln(['TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Proc="',FJumpToProcHead.Name,'"']);
9316       RaiseException(20170421201835,ctsNewProcBodyNotFound);
9317     end;
9318     Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
9319   end else begin
9320     {$IFDEF CTDEBUG}
9321     DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Adjust Cursor ... ');
9322     {$ENDIF}
9323     // there was no new proc body
9324     // -> adjust cursor
9325     AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
9326     Result:=true;
9327   end;
9328 end;
9329 
CompleteCodenull9330 function TCodeCompletionCodeTool.CompleteCode(CursorPos: TCodeXYPosition;
9331   OldTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine,
9332   BlockTopLine, BlockBottomLine: integer;
9333   SourceChangeCache: TSourceChangeCache; Interactive: Boolean): boolean;
9334 
TryCompleteLocalVarnull9335   function TryCompleteLocalVar(CleanCursorPos: integer;
9336     CursorNode: TCodeTreeNode): Boolean;
9337   begin
9338     // test if Local variable assignment (i:=3)
9339     Result:=CompleteVariableAssignment(CleanCursorPos,OldTopLine,
9340       CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9341     if Result then exit;
9342 
9343     // test if Local variable iterator (for i in j)
9344     Result:=CompleteVariableForIn(CleanCursorPos,OldTopLine,
9345       CursorNode,NewPos,NewTopLine,SourceChangeCache, Interactive);
9346     if Result then exit;
9347 
9348     // test if undeclared local variable as parameter (GetPenPos(x,y))
9349     Result:=CompleteIdentifierByParameter(CleanCursorPos,OldTopLine,
9350       CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9351     if Result then exit;
9352   end;
9353 
TryCompletenull9354   function TryComplete(CursorNode: TCodeTreeNode; CleanCursorPos: integer): Boolean;
9355   var
9356     ProcNode, AClassNode: TCodeTreeNode;
9357     IsEventAssignment: boolean;
9358   begin
9359     Result := False;
9360     FCompletingCursorNode:=CursorNode;
9361     try
9362 
9363       {$IFDEF CTDEBUG}
9364       DebugLn('TCodeCompletionCodeTool.CompleteCode A CleanCursorPos=',dbgs(CleanCursorPos),' NodeDesc=',NodeDescriptionAsString(CursorNode.Desc));
9365       {$ENDIF}
9366 
9367       // test if in a class
9368       AClassNode:=FindClassOrInterfaceNode(CursorNode);
9369       if AClassNode<>nil then begin
9370         Result:=CompleteClass(AClassNode,CleanCursorPos,OldTopLine,CursorNode,
9371                               NewPos,NewTopLine, BlockTopLine, BlockBottomLine);
9372         exit;
9373       end;
9374       {$IFDEF CTDEBUG}
9375       DebugLn('TCodeCompletionCodeTool.CompleteCode not in-a-class ... ');
9376       {$ENDIF}
9377 
9378       // test if forward proc
9379       //debugln('TCodeCompletionCodeTool.CompleteCode ',CursorNode.DescAsString);
9380       if CursorNode.Desc = ctnInterface then
9381       begin
9382         //Search nearest (to the left) CursorNode if we are within interface section
9383         CursorNode := CursorNode.LastChild;
9384         while Assigned(CursorNode) and (CursorNode.StartPos > CleanCursorPos) do
9385           CursorNode := CursorNode.PriorBrother;
9386         if (CursorNode=nil)
9387         or (not PositionsInSameLine(Src,CursorNode.EndPos,CleanCursorPos)) then
9388           CursorNode:=FCompletingCursorNode;
9389       end;
9390       ProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
9391       if (ProcNode=nil) and (CursorNode.Desc=ctnProcedure) then
9392         ProcNode:=CursorNode;
9393       if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure)
9394       and ((ProcNode.SubDesc and ctnsForwardDeclaration)>0) then begin
9395         // Node is forward Proc
9396         Result:=CompleteForwardProcs(CursorPos,ProcNode,CursorNode,NewPos,NewTopLine,
9397                              BlockTopLine, BlockBottomLine, SourceChangeCache);
9398         exit;
9399       end;
9400 
9401       // test if Event assignment (MyClick:=@Button1.OnClick)
9402       Result:=CompleteEventAssignment(CleanCursorPos,OldTopLine,CursorNode,
9403                              IsEventAssignment,NewPos,NewTopLine,SourceChangeCache,Interactive);
9404       if IsEventAssignment then exit;
9405 
9406       Result:=TryCompleteLocalVar(CleanCursorPos,CursorNode);
9407       if Result then exit;
9408 
9409       // test if procedure call
9410       Result:=CompleteProcByCall(CleanCursorPos,OldTopLine,
9411                                  CursorNode,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,SourceChangeCache);
9412       if Result then exit;
9413     finally
9414       FCompletingCursorNode:=nil;
9415     end;
9416   end;
9417 
TryFirstLocalIdentOccurencenull9418   function TryFirstLocalIdentOccurence(CursorNode: TCodeTreeNode;
9419     OrigCleanCursorPos, CleanCursorPos: Integer): boolean;
9420   var
9421     AtomContextNode, StatementNode: TCodeTreeNode;
9422     IdentAtom, LastCurPos: TAtomPosition;
9423     UpIdentifier: string;
9424     LastAtomIsDot: Boolean;
9425     Params: TFindDeclarationParams;
9426     OldCodePos: TCodePosition;
9427   begin
9428     Result := false;
9429 
9430     // get enclosing Begin block
9431     if not (CursorNode.Desc in AllPascalStatements) then exit;
9432     StatementNode:=CursorNode;
9433     while StatementNode<>nil do begin
9434       if (StatementNode.Desc=ctnBeginBlock) then begin
9435         if (StatementNode.Parent.Desc in [ctnProcedure,ctnProgram]) then break;
9436       end else if StatementNode.Desc in [ctnInitialization,ctnFinalization] then
9437         break;
9438       StatementNode:=StatementNode.Parent;
9439     end;
9440     if StatementNode=nil then exit;
9441 
9442     // read UpIdentifier at CleanCursorPos
9443     GetIdentStartEndAtPosition(Src,CleanCursorPos,
9444       IdentAtom.StartPos,IdentAtom.EndPos);
9445     if IdentAtom.StartPos=IdentAtom.EndPos then
9446       Exit;
9447 
9448     MoveCursorToAtomPos(IdentAtom);
9449     if not AtomIsIdentifier then
9450       Exit; // a keyword
9451 
9452     UpIdentifier := GetUpAtom;
9453 
9454     //find first occurence of UpIdentifier from procedure begin until CleanCursorPos
9455     //we are interested only in local variables/identifiers
9456     //  --> the UpIdentifier must not be preceded by a point ("MyObject.I" - if we want to complete I)
9457     //      and then do another check if it is not available with the "with" command, e.g.
9458     MoveCursorToCleanPos(StatementNode.StartPos);
9459     if StatementNode.Desc=ctnBeginBlock then
9460       BuildSubTreeForBeginBlock(StatementNode);
9461     LastAtomIsDot := False;
9462     while CurPos.EndPos < CleanCursorPos do
9463     begin
9464       ReadNextAtom;
9465       if not LastAtomIsDot and AtomIsIdentifier and UpAtomIs(UpIdentifier) then
9466       begin
9467         AtomContextNode:=FindDeepestNodeAtPos(StatementNode,CurPos.StartPos,true);
9468         Params:=TFindDeclarationParams.Create(Self, AtomContextNode);
9469         try
9470           // check if UpIdentifier doesn't exists (e.g. because of a with statement)
9471           LastCurPos := CurPos;
9472           if not IdentifierIsDefined(CurPos,AtomContextNode,Params) then
9473           begin
9474             FCompletingCursorNode:=CursorNode;
9475             try
9476               if not CleanPosToCodePos(OrigCleanCursorPos,OldCodePos) then
9477                 RaiseException(20170421201838,'TCodeCompletionCodeTool.TryFirstLocalIdentOccurence CleanPosToCodePos');
9478               CompleteCode:=TryCompleteLocalVar(LastCurPos.StartPos,AtomContextNode);
9479               AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
9480               exit(true);
9481             finally
9482               FCompletingCursorNode:=nil;
9483             end;
9484           end;
9485           CurPos := LastCurPos;//IdentifierIsDefined changes the CurPos
9486         finally
9487           Params.Free;
9488         end;
9489       end;
9490       LastAtomIsDot := CurPos.Flag=cafPoint;
9491     end;
9492   end;
9493 
9494   procedure ClearAndRaise(var E: ECodeToolError; CleanPos: Integer);
9495   var
9496     TempE: ECodeToolError;
9497   begin
9498     TempE := E;
9499     E := nil;
9500     MoveCursorToCleanPos(CleanPos);
9501     RaiseExceptionInstance(TempE);
9502   end;
9503 
9504   function TryAssignment(CursorNode: TCodeTreeNode;
9505     OrigCleanCursorPos, CleanCursorPos: Integer): Boolean;
9506   var
9507     OldCodePos: TCodePosition;
9508   begin
9509     // Search only within the current statement - stop on semicolon or keywords
9510     //   (else isn't prepended by a semicolon in contrast to other keywords).
9511 
9512     Result := False;
9513     MoveCursorToNearestAtom(CleanCursorPos);
9514     while CurPos.StartPos > 1 do
9515     begin
9516       ReadPriorAtom;
9517       case CurPos.Flag of
9518         cafAssignment:
9519         begin
9520           // OK FOUND!
9521           ReadPriorAtom;
9522           FCompletingCursorNode:=CursorNode;
9523           try
9524             if TryComplete(CursorNode, CurPos.StartPos) then
9525             begin
9526               if not CleanPosToCodePos(OrigCleanCursorPos,OldCodePos) then
9527                 RaiseException(20170421201842,'TCodeCompletionCodeTool.CompleteCode CleanPosToCodePos');
9528               AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
9529               exit(true);
9530             end;
9531             break;
9532           finally
9533             FCompletingCursorNode:=nil;
9534           end;
9535         end;
9536         cafWord: // stop on keywords
9537           if UpAtomIs('BEGIN') or UpAtomIs('END')
9538           or UpAtomIs('TRY') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
9539           or UpAtomIs('FOR') or UpAtomIs('TO') or UpAtomIs('DO')
9540           or UpAtomIs('REPEAT') or UpAtomIs('UNTIL') or UpAtomIs('WHILE')
9541           or UpAtomIs('IF') or UpAtomIs('THEN') or UpAtomIs('CASE') or UpAtomIs('ELSE')
9542           then
9543             break;
9544         cafSemicolon:
9545           break; // stop on semicolon
9546       end;
9547     end;
9548   end;
9549 
9550 var
9551   CleanCursorPos, OrigCleanCursorPos: integer;
9552   CursorNode: TCodeTreeNode;
9553   LastCodeToolsErrorCleanPos: Integer;
9554   LastCodeToolsError: ECodeToolError;
9555 begin
9556   BlockTopLine := -1;
9557   BlockBottomLine := -1;
9558   //DebugLn(['TCodeCompletionCodeTool.CompleteCode CursorPos=',Dbgs(CursorPos),' OldTopLine=',OldTopLine]);
9559 
9560   Result:=false;
9561   if (SourceChangeCache=nil) then
9562     RaiseException(20170421201857,'need a SourceChangeCache');
9563   BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
9564                           [btSetIgnoreErrorPos]);
9565   OrigCleanCursorPos:=CleanCursorPos;
9566   NewPos:=CleanCodeXYPosition;
9567   NewTopLine:=0;
9568 
9569   // find CodeTreeNode at cursor
9570   // skip newline chars
9571   while (CleanCursorPos>1) and (Src[CleanCursorPos] in [#10,#13]) do
9572     dec(CleanCursorPos);
9573   // skip space (first try left)
9574   while (CleanCursorPos>1) and (Src[CleanCursorPos] in [' ',#9,';']) do
9575     dec(CleanCursorPos);
9576   if (CleanCursorPos>0) and (CleanCursorPos<SrcLen)
9577   and (Src[CleanCursorPos] in [#10,#13]) then begin
9578     // then try right
9579     repeat
9580       inc(CleanCursorPos);
9581     until (CleanCursorPos>=SrcLen) or (not (Src[CleanCursorPos] in [' ',#9]));
9582   end;
9583 
9584   CodeCompleteSrcChgCache:=SourceChangeCache;
9585   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
9586 
9587   LastCodeToolsError := nil;
9588   try
9589     try
9590       if TryComplete(CursorNode, CleanCursorPos) then
9591         exit(true);
9592 
9593       { Find the first occurence of the (local) identifier at cursor in current
9594         procedure body and try again. }
9595       if TryFirstLocalIdentOccurence(CursorNode,OrigCleanCursorPos,CleanCursorPos) then
9596         exit(true);
9597     except
9598       on E: ECodeToolError do
9599       begin
9600         // we have a codetool error, let's try to find the assignment in any case
9601         LastCodeToolsErrorCleanPos := CurPos.StartPos;
9602         LastCodeToolsError := ECodeToolError.Create(E.Sender,E.Id,E.Message);
9603       end else
9604         raise;
9605     end;
9606 
9607     // find first assignment before current.
9608     if TryAssignment(CursorNode, OrigCleanCursorPos, CleanCursorPos) then
9609       Exit(true);
9610 
9611     if LastCodeToolsError<>nil then // no assignment found, reraise
9612       ClearAndRaise(LastCodeToolsError, LastCodeToolsErrorCleanPos);
9613   finally
9614     LastCodeToolsError.Free;
9615   end;
9616 
9617   if CompleteMethodByBody(OrigCleanCursorPos,OldTopLine,CursorNode,
9618                          NewPos,NewTopLine,SourceChangeCache)
9619   then
9620     exit(true);
9621 
9622   {$IFDEF CTDEBUG}
9623   DebugLn('TCodeCompletionCodeTool.CompleteCode  nothing to complete ... ');
9624   {$ENDIF}
9625 end;
9626 
CreateVariableForIdentifiernull9627 function TCodeCompletionCodeTool.CreateVariableForIdentifier(
9628   CursorPos: TCodeXYPosition; OldTopLine: integer; out NewPos: TCodeXYPosition;
9629   out NewTopLine: integer; SourceChangeCache: TSourceChangeCache; Interactive: Boolean
9630   ): boolean;
9631 var
9632   CleanCursorPos: integer;
9633   CursorNode: TCodeTreeNode;
9634 begin
9635   Result:=false;
9636   NewPos:=CleanCodeXYPosition;
9637   NewTopLine:=0;
9638   if (SourceChangeCache=nil) then
9639     RaiseException(20170421201910,'need a SourceChangeCache');
9640   BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
9641 
9642   CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
9643   CodeCompleteSrcChgCache:=SourceChangeCache;
9644 
9645   {$IFDEF CTDEBUG}
9646   DebugLn('TCodeCompletionCodeTool.CreateVariableForIdentifier A CleanCursorPos=',dbgs(CleanCursorPos),' NodeDesc=',NodeDescriptionAsString(CursorNode.Desc));
9647   {$ENDIF}
9648 
9649   // test if Local variable assignment (i:=3)
9650   Result:=CompleteVariableAssignment(CleanCursorPos,OldTopLine,
9651     CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9652   if Result then exit;
9653 
9654   // test if undeclared local variable as parameter (GetPenPos(x,y))
9655   Result:=CompleteIdentifierByParameter(CleanCursorPos,OldTopLine,
9656     CursorNode,NewPos,NewTopLine,SourceChangeCache,Interactive);
9657   if Result then exit;
9658 
9659   MoveCursorToCleanPos(CleanCursorPos);
9660   RaiseException(20170421201915,'this syntax is not supported by variable completion');
9661 end;
9662 
AddMethodsnull9663 function TCodeCompletionCodeTool.AddMethods(CursorPos: TCodeXYPosition;
9664   OldTopLine: integer; ListOfPCodeXYPosition: TFPList;
9665   const VirtualToOverride: boolean; out NewPos: TCodeXYPosition; out
9666   NewTopLine, BlockTopLine, BlockBottomLine: integer;
9667   SourceChangeCache: TSourceChangeCache): boolean;
9668 var
9669   CleanCursorPos: integer;
9670   CursorNode: TCodeTreeNode;
9671   i: Integer;
9672   CodeXYPos: TCodeXYPosition;
9673   ProcNode: TCodeTreeNode;
9674   NewMethods: TAVLTree;// Tree of TCodeTreeNodeExtension
9675   NewCodeTool: TFindDeclarationTool;
9676   CleanProcCode: String;
9677   FullProcCode: String;
9678   VirtualStartPos: LongInt;
9679   VirtualEndPos: integer;
9680   VisibilityDesc: TCodeTreeNodeDesc;
9681   NodeExt: TCodeTreeNodeExtension;
9682   AVLNode: TAVLTreeNode;
9683   ProcName: String;
9684   NewClassPart: TNewClassPart;
9685   Beauty: TBeautifyCodeOptions;
9686   ProcCode: String;
9687   CurClassName: String;
9688 begin
9689   Result:=false;
9690   if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then
9691     exit(true);
9692 
9693   if (SourceChangeCache=nil) then
9694     RaiseException(20170421201918,'need a SourceChangeCache');
9695 
9696   CodeCompleteSrcChgCache:=SourceChangeCache;
9697   Beauty:=SourceChangeCache.BeautifyCodeOptions;
9698   NewMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
9699   try
9700     ActivateGlobalWriteLock;
9701     try
9702       // collect all methods
9703       for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
9704         //get next code position
9705         CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
9706         // get codetool for this position
9707         NewCodeTool:=OnGetCodeToolForBuffer(Self,CodeXYPos.Code,true);
9708         if NewCodeTool=nil then begin
9709           DebugLn(['TCodeCompletionCodeTool.AddMethods unit not found for source ',CodeXYPos.Code.Filename,'(',CodeXYPos.Y,',',CodeXYPos.X,')']);
9710           exit;
9711         end;
9712         // parse unit
9713         NewCodeTool.BuildTreeAndGetCleanPos(CodeXYPos,CleanCursorPos);
9714         // find node at position
9715         ProcNode:=NewCodeTool.BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
9716         if (ProcNode.Desc<>ctnProcedure)
9717         or (ProcNode.Parent=nil) then begin
9718           NewCodeTool.MoveCursorToNodeStart(ProcNode);
9719           RaiseException(20170421201921,'TCodeCompletionCodeTool.AddMethods source position not a procedure');
9720         end;
9721         // find visibility
9722         VisibilityDesc:=ctnClassPublic;
9723         if ProcNode.Parent.Desc in AllClassBaseSections then
9724           VisibilityDesc:=ProcNode.Parent.Desc;
9725         // extract proc
9726         ProcName:=NewCodeTool.ExtractProcName(ProcNode,[phpWithoutClassName,phpInUpperCase]);
9727         CleanProcCode:=NewCodeTool.ExtractProcHead(ProcNode,[phpWithoutClassName]);
9728         FullProcCode:=NewCodeTool.ExtractProcHead(ProcNode,
9729                     [phpWithStart,phpWithoutClassName,phpWithVarModifiers,
9730                      phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
9731                      phpWithCallingSpecs,phpWithProcModifiers]);
9732         if VirtualToOverride then begin
9733           VirtualStartPos:=SearchProcSpecifier(FullProcCode,'virtual',
9734                           VirtualEndPos,NewCodeTool.Scanner.NestedComments);
9735           debugln(['TCodeCompletionCodeTool.AddMethods FullProcCode="',FullProcCode,'" VirtualStartPos=',VirtualStartPos]);
9736           if VirtualStartPos>=1 then begin
9737             // replace virtual with override
9738             FullProcCode:=copy(FullProcCode,1,VirtualStartPos-1)
9739                          +'override;'
9740                          +copy(FullProcCode,VirtualEndPos,length(FullProcCode));
9741           end;
9742           // remove abstract
9743           FullProcCode:=RemoveProcSpecifier(FullProcCode,'abstract',
9744                                             NewCodeTool.Scanner.NestedComments);
9745         end;
9746 
9747         ProcCode:=NewCodeTool.ExtractProcHead(ProcNode,[phpWithStart,
9748                   phpWithoutClassName,phpWithVarModifiers,phpWithParameterNames,
9749                   phpWithResultType,phpWithCallingSpecs]);
9750         ProcCode:=ProcCode+Beauty.LineEnd
9751                     +'begin'+Beauty.LineEnd
9752                     +Beauty.GetIndentStr(Beauty.Indent)+Beauty.LineEnd
9753                     +'end;';
9754 
9755         // add method data
9756         NodeExt:=TCodeTreeNodeExtension.Create;
9757         NodeExt.Txt:=CleanProcCode;
9758         NodeExt.ExtTxt1:=FullProcCode;
9759         NodeExt.ExtTxt2:=ProcName;
9760         NodeExt.ExtTxt3:=ProcCode;
9761         NodeExt.Flags:=VisibilityDesc;
9762         NewMethods.Add(NodeExt);
9763         //DebugLn(['TCodeCompletionCodeTool.AddMethods ',i,' CleanProcTxt=',CleanProcCode,' FullProcTxt=',FullProcCode]);
9764       end;
9765 
9766     finally
9767       DeactivateGlobalWriteLock;
9768     end;
9769 
9770     BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
9771 
9772     // find node at position
9773     CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
9774 
9775     // if cursor is on type node, find class node
9776     if CursorNode.Desc=ctnTypeDefinition then
9777       CursorNode:=CursorNode.FirstChild
9778     else if CursorNode.Desc=ctnGenericType then
9779       CursorNode:=CursorNode.LastChild
9780     else
9781       CursorNode:=FindClassOrInterfaceNode(CursorNode);
9782     if (CursorNode=nil) or (not (CursorNode.Desc in AllClasses)) then begin
9783       DebugLn(['TIdentCompletionTool.AddMethods cursor not in a class']);
9784       exit;
9785     end;
9786     //DebugLn(['TCodeCompletionCodeTool.AddMethods CursorNode=',CursorNode.DescAsString]);
9787 
9788     CodeCompleteSrcChgCache:=SourceChangeCache;
9789     CodeCompleteClassNode:=CursorNode;
9790     CurClassName:=ExtractClassName(CursorNode,false);
9791 
9792     // add methods
9793     AVLNode:=NewMethods.FindLowest;
9794     while AVLNode<>nil do begin
9795       NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
9796       CleanProcCode:=NodeExt.Txt;
9797       FullProcCode:=NodeExt.ExtTxt1;
9798       ProcName:=NodeExt.ExtTxt2;
9799       ProcCode:=NodeExt.ExtTxt3;
9800       VisibilityDesc:=TCodeTreeNodeDesc(NodeExt.Flags);
9801       case VisibilityDesc of
9802       ctnClassPrivate:   NewClassPart:=ncpPrivateProcs;
9803       ctnClassProtected: NewClassPart:=ncpProtectedProcs;
9804       ctnClassPublic:    NewClassPart:=ncpPublicProcs;
9805       ctnClassPublished: NewClassPart:=ncpPublishedProcs;
9806       else               NewClassPart:=ncpPublicProcs;
9807       end;
9808 
9809       // change classname
9810       ProcCode:=Beauty.AddClassAndNameToProc(ProcCode,CurClassName,ProcName);
9811       AddClassInsertion(CleanProcCode,FullProcCode,ProcName,NewClassPart,nil,
9812                         ProcCode);
9813 
9814       AVLNode:=NewMethods.FindSuccessor(AVLNode);
9815     end;
9816 
9817     // apply changes
9818     if not ApplyChangesAndJumpToFirstNewProc(CleanCursorPos,OldTopLine,true,
9819       NewPos,NewTopLine, BlockTopLine, BlockBottomLine) then exit;
9820 
9821     Result:=true;
9822   finally
9823     FreeClassInsertionList;
9824     DisposeAVLTree(NewMethods);
9825   end;
9826 end;
9827 
9828 constructor TCodeCompletionCodeTool.Create;
9829 begin
9830   inherited Create;
9831   FSetPropertyVariablename:='AValue';
9832   FSetPropertyVariableIsPrefix := false;
9833   FSetPropertyVariableUseConst := false;
9834   FCompleteProperties:=true;
9835   FAddInheritedCodeToOverrideMethod:=true;
9836 end;
9837 
9838 end.
9839 
9840