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