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