← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to .pc/spell_errors.diff/components/codetools/identcompletiontool.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/spell_errors.diff/components/codetools/identcompletiontool.pas
 
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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 
18
 *                                                                         *
 
19
 ***************************************************************************
 
20
 
 
21
  Author: Mattias Gaertner
 
22
 
 
23
  Abstract:
 
24
    TIdentCompletionTool enhances the TFindDeclarationTool with the ability
 
25
    to create lists of valid identifiers at a specific code position.
 
26
}
 
27
unit IdentCompletionTool;
 
28
 
 
29
{$mode objfpc}{$H+}
 
30
 
 
31
interface
 
32
 
 
33
{$I codetools.inc}
 
34
 
 
35
// activate for debug:
 
36
 
 
37
// mem check
 
38
{ $DEFINE MEM_CHECK}
 
39
 
 
40
// verbosity
 
41
{ $DEFINE CTDEBUG}
 
42
{ $DEFINE ShowFoundIdents}
 
43
{ $DEFINE ShowFilteredIdents}
 
44
{ $DEFINE ShowHistory}
 
45
 
 
46
uses
 
47
  {$IFDEF MEM_CHECK}
 
48
  MemCheck,
 
49
  {$ENDIF}
 
50
  Classes, SysUtils, FileProcs, CodeTree, CodeAtom, CodeCache, CustomCodeTool,
 
51
  CodeToolsStrConsts, KeywordFuncLists, BasicCodeTools, LinkScanner, AVL_Tree,
 
52
  CodeToolMemManager, DefineTemplates, SourceChanger, FindDeclarationTool,
 
53
  PascalReaderTool, PascalParserTool, CodeToolsStructs, ExprEval;
 
54
  
 
55
type
 
56
  TIdentCompletionTool = class;
 
57
  TIdentifierHistoryList = class;
 
58
 
 
59
  //----------------------------------------------------------------------------
 
60
  // gathered identifier list
 
61
 
 
62
  TIdentifierCompatibility = (
 
63
    icompExact,
 
64
    icompCompatible,
 
65
    icompUnknown,
 
66
    icompIncompatible
 
67
    );
 
68
  TIdentifierCompatibilities = set of TIdentifierCompatibility;
 
69
  
 
70
  TIdentListItemFlag = (
 
71
    iliHasChilds,
 
72
    iliBaseExprTypeValid,
 
73
    iliIsFunction,
 
74
    iliIsFunctionValid,
 
75
    iliIsAbstractMethod,
 
76
    iliIsAbstractMethodValid,
 
77
    iliParamTypeListValid,
 
78
    iliParamNameListValid,
 
79
    iliNodeValid,
 
80
    iliNodeHashValid,
 
81
    iliNodeGoneWarned,
 
82
    iliIsConstructor,
 
83
    iliIsConstructorValid,
 
84
    iliIsDestructor,
 
85
    iliIsDestructorValid,
 
86
    iliKeyword,
 
87
    iliResultTypeValid,
 
88
    iliHasIndexValid,
 
89
    iliHasIndex,
 
90
    iliHasParamListValid,
 
91
    iliHasParamList,
 
92
    iliIsReadOnlyValid,
 
93
    iliIsReadOnly,
 
94
    iliHintModifiersValid,
 
95
    iliIsDeprecated,
 
96
    iliIsPlatform,
 
97
    iliIsExperimental,
 
98
    iliIsUnimplemented,
 
99
    iliIsLibrary,
 
100
    iliAtCursor // the item is the identifier at the completion
 
101
    );
 
102
  TIdentListItemFlags = set of TIdentListItemFlag;
 
103
  
 
104
  { TIdentifierListSearchItem }
 
105
 
 
106
  TIdentifierListSearchItem = class
 
107
  public
 
108
    Identifier: PChar;
 
109
    ParamList: string;
 
110
    function CalcMemSize: PtrUInt;
 
111
  end;
 
112
 
 
113
  { TIdentifierListItem }
 
114
 
 
115
  TIdentifierListItem = class
 
116
  private
 
117
    FParamTypeList: string;
 
118
    FParamNameList: string;
 
119
    FNode: TCodeTreeNode;
 
120
    FResultType: string;
 
121
    FToolNodesDeletedStep: integer;// only valid if iliNodeValid
 
122
    FNodeStartPos: integer;
 
123
    FNodeDesc: TCodeTreeNodeDesc;
 
124
    FNodeHash: string;
 
125
    function GetNode: TCodeTreeNode;
 
126
    function GetParamTypeList: string;
 
127
    function GetParamNameList: string;
 
128
    procedure SetNode(const AValue: TCodeTreeNode);
 
129
    procedure SetParamTypeList(const AValue: string);
 
130
    procedure SetParamNameList(const AValue: string);
 
131
    procedure SetResultType(const AValue: string);
 
132
  public
 
133
    Compatibility: TIdentifierCompatibility;
 
134
    HistoryIndex: integer;
 
135
    Identifier: string;
 
136
    Level: integer;
 
137
    Tool: TFindDeclarationTool;
 
138
    DefaultDesc: TCodeTreeNodeDesc;
 
139
    Flags: TIdentListItemFlags;
 
140
    BaseExprType: TExpressionType;
 
141
    function AsString: string;
 
142
    function GetDesc: TCodeTreeNodeDesc;
 
143
    constructor Create(NewCompatibility: TIdentifierCompatibility;
 
144
                       NewHasChilds: boolean; NewHistoryIndex: integer;
 
145
                       NewIdentifier: PChar; NewLevel: integer;
 
146
                       NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
 
147
                       NewDefaultDesc: TCodeTreeNodeDesc);
 
148
    function IsProcNodeWithParams: boolean;
 
149
    function IsPropertyWithParams: boolean;
 
150
    function IsPropertyReadOnly: boolean;
 
151
    function GetHintModifiers: TPascalHintModifiers;
 
152
    function CheckHasChilds: boolean;
 
153
    function CanBeAssigned: boolean;
 
154
    procedure UpdateBaseContext;
 
155
    function HasChilds: boolean;
 
156
    function HasIndex: boolean;
 
157
    function IsFunction: boolean;
 
158
    function IsContructor: boolean;
 
159
    function IsDestructor: boolean;
 
160
    function IsAbstractMethod: boolean;
 
161
    function TryIsAbstractMethod: boolean;
 
162
    procedure Clear;
 
163
    procedure UnbindNode;
 
164
    procedure StoreNodeHash;
 
165
    function RestoreNode: boolean;
 
166
    function GetNodeHash(ANode: TCodeTreeNode): string;
 
167
    function CompareParamList(CompareItem: TIdentifierListItem): integer;
 
168
    function CompareParamList(CompareItem: TIdentifierListSearchItem): integer;
 
169
    function CalcMemSize: PtrUInt;
 
170
  public
 
171
    property ParamTypeList: string read GetParamTypeList write SetParamTypeList;
 
172
    property ParamNameList: string read GetParamNameList write SetParamNameList;
 
173
    property ResultType: string read FResultType write SetResultType;
 
174
    property Node: TCodeTreeNode read GetNode write SetNode;
 
175
  end;
 
176
  
 
177
  TIdentifierListFlag = (
 
178
    ilfFilteredListNeedsUpdate,
 
179
    ilfUsedToolsNeedsUpdate
 
180
    );
 
181
  TIdentifierListFlags = set of TIdentifierListFlag;
 
182
  
 
183
  TIdentifierListContextFlag = (
 
184
    ilcfStartInStatement,  // context starts in statements. e.g. between begin..end
 
185
    ilcfStartOfStatement,  // atom is start of statement. e.g. 'A|:=' or 'A|;', does not check if A can be assigned
 
186
    ilcfStartOfOperand,    // atom is start of an operand. e.g. 'A|.B'
 
187
    ilcfStartIsSubIdent,   // atom in front is point
 
188
    ilcfNeedsEndSemicolon, // after context a semicolon is needed. e.g. 'A| end'
 
189
    ilcfNoEndSemicolon,    // no semicolon after. E.g. 'A| else'
 
190
    ilcfNeedsEndComma,     // after context a comma is needed. e.g. 'uses sysutil| classes'
 
191
    ilcfNeedsDo,           // after context a 'do' is needed. e.g. 'with Form1| do'
 
192
    ilcfIsExpression,      // is expression part of statement. e.g. 'if expr'
 
193
    ilcfCanProcDeclaration,// context allows to declare a procedure/method
 
194
    ilcfEndOfLine          // atom at end of line
 
195
    );
 
196
  TIdentifierListContextFlags = set of TIdentifierListContextFlag;
 
197
  
 
198
  TIdentifierList = class
 
199
  private
 
200
    FContext: TFindContext;
 
201
    FNewMemberVisibility: TCodeTreeNodeDesc;
 
202
    FContextFlags: TIdentifierListContextFlags;
 
203
    FStartAtom: TAtomPosition;
 
204
    FStartAtomBehind: TAtomPosition;
 
205
    FStartAtomInFront: TAtomPosition;
 
206
    FStartBracketLvl: integer;
 
207
    FStartContextPos: TCodeXYPosition;
 
208
    FCreatedIdentifiers: TFPList; // list of PChar
 
209
    FFilteredList: TFPList; // list of TIdentifierListItem
 
210
    FFlags: TIdentifierListFlags;
 
211
    FHistory: TIdentifierHistoryList;
 
212
    FItems: TAVLTree; // tree of TIdentifierListItem (completely sorted)
 
213
    FIdentView: TAVLTree; // tree of TIdentHistListItem sorted for identifiers
 
214
    FUsedTools: TAVLTree; // tree of TFindDeclarationTool
 
215
    FIdentSearchItem: TIdentifierListSearchItem;
 
216
    FPrefix: string;
 
217
    FStartContext: TFindContext;
 
218
    procedure SetHistory(const AValue: TIdentifierHistoryList);
 
219
    procedure UpdateFilteredList;
 
220
    function GetFilteredItems(Index: integer): TIdentifierListItem;
 
221
    procedure SetPrefix(const AValue: string);
 
222
  public
 
223
    constructor Create;
 
224
    destructor Destroy; override;
 
225
    procedure Clear;
 
226
    procedure Add(NewItem: TIdentifierListItem);
 
227
    function Count: integer;
 
228
    function GetFilteredCount: integer;
 
229
    function HasIdentifier(Identifier: PChar; const ParamList: string): boolean;
 
230
    function FindIdentifier(Identifier: PChar; const ParamList: string): TIdentifierListItem;
 
231
    function FindCreatedIdentifier(const Ident: string): integer;
 
232
    function CreateIdentifier(const Ident: string): PChar;
 
233
    function StartUpAtomInFrontIs(const s: string): boolean;
 
234
    function StartUpAtomBehindIs(const s: string): boolean;
 
235
    function CompletePrefix(const OldPrefix: string): string;
 
236
    function CalcMemSize: PtrUInt;
 
237
  public
 
238
    property Context: TFindContext read FContext write FContext;
 
239
    property ContextFlags: TIdentifierListContextFlags
 
240
                                       read FContextFlags write FContextFlags;
 
241
    property NewMemberVisibility: TCodeTreeNodeDesc // identifier is a class member, e.g. a variable or a procedure name
 
242
                     read FNewMemberVisibility write FNewMemberVisibility;
 
243
    property FilteredItems[Index: integer]: TIdentifierListItem
 
244
                                                          read GetFilteredItems;
 
245
    property History: TIdentifierHistoryList read FHistory write SetHistory;
 
246
    property Prefix: string read FPrefix write SetPrefix;
 
247
    property StartAtom: TAtomPosition read FStartAtom write FStartAtom;
 
248
    property StartAtomInFront: TAtomPosition
 
249
                                 read FStartAtomInFront write FStartAtomInFront; // in front of variable, not only of identifier
 
250
    property StartAtomBehind: TAtomPosition
 
251
                                   read FStartAtomBehind write FStartAtomBehind; // directly behind
 
252
    property StartBracketLvl: integer
 
253
                                   read FStartBracketLvl write FStartBracketLvl;
 
254
    property StartContext: TFindContext read FStartContext write FStartContext;
 
255
    property StartContextPos: TCodeXYPosition
 
256
                                   read FStartContextPos write FStartContextPos;
 
257
  end;
 
258
  
 
259
  //----------------------------------------------------------------------------
 
260
  // history list
 
261
 
 
262
  { TIdentHistListItem }
 
263
 
 
264
  TIdentHistListItem = class
 
265
  public
 
266
    Identifier: string;
 
267
    NodeDesc: TCodeTreeNodeDesc;
 
268
    ParamList: string;
 
269
    HistoryIndex: integer;
 
270
    function CalcMemSize: PtrUInt;
 
271
  end;
 
272
 
 
273
  { TIdentifierHistoryList }
 
274
 
 
275
  TIdentifierHistoryList = class
 
276
  private
 
277
    FCapacity: integer;
 
278
    FItems: TAVLTree; // tree of TIdentHistListItem
 
279
    procedure SetCapacity(const AValue: integer);
 
280
    function FindItem(NewItem: TIdentifierListItem): TAVLTreeNode;
 
281
  public
 
282
    constructor Create;
 
283
    destructor Destroy; override;
 
284
    procedure Clear;
 
285
    procedure Add(NewItem: TIdentifierListItem);
 
286
    function GetHistoryIndex(AnItem: TIdentifierListItem): integer;
 
287
    function Count: integer;
 
288
    function CalcMemSize: PtrUInt;
 
289
  public
 
290
    property Capacity: integer read FCapacity write SetCapacity;
 
291
  end;
 
292
 
 
293
 
 
294
  //----------------------------------------------------------------------------
 
295
 
 
296
  { TCodeContextInfoItem }
 
297
 
 
298
  TCodeContextInfoItem = class
 
299
  public
 
300
    Expr: TExpressionType;
 
301
    // compiler predefined proc
 
302
    ProcName: string;
 
303
    Params: TStringList;
 
304
    ResultType: string;
 
305
    destructor Destroy; override;
 
306
  end;
 
307
 
 
308
  { TCodeContextInfo }
 
309
 
 
310
  TCodeContextInfo = class
 
311
  private
 
312
    FEndPos: integer;
 
313
    FItems: TFPList; // list of TCodeContextInfoItem
 
314
    FParameterIndex: integer;
 
315
    FProcName: string;
 
316
    FProcNameAtom: TAtomPosition;
 
317
    FStartPos: integer;
 
318
    FTool: TFindDeclarationTool;
 
319
    function GetItems(Index: integer): TCodeContextInfoItem;
 
320
  public
 
321
    constructor Create;
 
322
    destructor Destroy; override;
 
323
    function Count: integer;
 
324
    property Items[Index: integer]: TCodeContextInfoItem read GetItems; default;
 
325
    function Add(const Context: TExpressionType): integer;
 
326
    function AddCompilerProc: integer;
 
327
    procedure Clear;
 
328
    property Tool: TFindDeclarationTool read FTool write FTool;
 
329
    property ParameterIndex: integer read FParameterIndex write FParameterIndex;// 1 based
 
330
    property ProcName: string read FProcName write FProcName;
 
331
    property ProcNameAtom: TAtomPosition read FProcNameAtom write FProcNameAtom;
 
332
    property StartPos: integer read FStartPos write FStartPos;// context is valid from StartPos to EndPos
 
333
    property EndPos: integer read FEndPos write FEndPos;
 
334
 
 
335
    function CalcMemSize: PtrUInt;
 
336
  end;
 
337
 
 
338
  //----------------------------------------------------------------------------
 
339
  // TIdentCompletionTool
 
340
 
 
341
  TIdentCompletionTool = class(TFindDeclarationTool)
 
342
  private
 
343
    FLastGatheredIdentParent: TCodeTreeNode;
 
344
    FLastGatheredIdentLevel: integer;
 
345
    FICTClassAndAncestors: TFPList;// list of PCodeXYPosition
 
346
    FIDCTFoundPublicProperties: TAVLTree;// tree of PChar (pointing to the
 
347
                                    // property names in source)
 
348
    FIDTFoundMethods: TAVLTree;// tree of TCodeTreeNodeExtension Txt=clean text
 
349
    FIDTTreeOfUnitFiles: TAVLTree;// tree of TUnitFileInfo
 
350
    procedure AddToTreeOfUnitFileInfo(const AFilename: string);
 
351
  protected
 
352
    CurrentIdentifierList: TIdentifierList;
 
353
    CurrentIdentifierContexts: TCodeContextInfo;
 
354
    function CollectAllIdentifiers(Params: TFindDeclarationParams;
 
355
      const FoundContext: TFindContext): TIdentifierFoundResult;
 
356
    procedure GatherPredefinedIdentifiers(CleanPos: integer;
 
357
      const Context: TFindContext; BeautifyCodeOptions: TBeautifyCodeOptions);
 
358
    procedure GatherUsefulIdentifiers(CleanPos: integer;
 
359
      const Context: TFindContext; BeautifyCodeOptions: TBeautifyCodeOptions);
 
360
    procedure GatherUnitnames;
 
361
    procedure GatherSourceNames(const Context: TFindContext);
 
362
    procedure GatherContextKeywords(const Context: TFindContext;
 
363
      CleanPos: integer; BeautifyCodeOptions: TBeautifyCodeOptions);
 
364
    procedure InitCollectIdentifiers(const CursorPos: TCodeXYPosition;
 
365
      var IdentifierList: TIdentifierList);
 
366
    procedure ParseSourceTillCollectionStart(const CursorPos: TCodeXYPosition;
 
367
      out CleanCursorPos: integer; out CursorNode: TCodeTreeNode;
 
368
      out IdentStartPos, IdentEndPos: integer);
 
369
    function FindIdentifierStartPos(const CursorPos: TCodeXYPosition
 
370
                                      ): TCodeXYPosition;
 
371
    procedure FindCollectionContext(Params: TFindDeclarationParams;
 
372
      IdentStartPos: integer; CursorNode: TCodeTreeNode;
 
373
      out GatherContext: TFindContext; out ContextExprStartPos: LongInt;
 
374
      out StartInSubContext: Boolean);
 
375
    function CollectAllContexts(Params: TFindDeclarationParams;
 
376
      const FoundContext: TFindContext): TIdentifierFoundResult;
 
377
    procedure AddCollectionContext(Tool: TFindDeclarationTool;
 
378
      Node: TCodeTreeNode);
 
379
    procedure InitFoundMethods;
 
380
    procedure ClearFoundMethods;
 
381
    function CollectMethods(Params: TFindDeclarationParams;
 
382
      const FoundContext: TFindContext): TIdentifierFoundResult;
 
383
    function IsInCompilerDirective(CursorPos: TCodeXYPosition): boolean;
 
384
  public
 
385
    function GatherAvailableUnitNames(const CursorPos: TCodeXYPosition;
 
386
                             var IdentifierList: TIdentifierList): Boolean;
 
387
    function GatherIdentifiers(const CursorPos: TCodeXYPosition;
 
388
                            var IdentifierList: TIdentifierList;
 
389
                            BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
 
390
    function FindCodeContext(const CursorPos: TCodeXYPosition;
 
391
                             out CodeContexts: TCodeContextInfo): boolean;
 
392
    function FindAbstractMethods(const CursorPos: TCodeXYPosition;
 
393
                                 out ListOfPCodeXYPosition: TFPList;
 
394
                                 SkipAbstractsInStartClass: boolean = false): boolean;
 
395
    function GetValuesOfCaseVariable(const CursorPos: TCodeXYPosition;
 
396
                                     List: TStrings): boolean;
 
397
 
 
398
    procedure CalcMemSize(Stats: TCTMemStats); override;
 
399
  end;
 
400
  
 
401
implementation
 
402
 
 
403
function CompareIdentListItems(Data1, Data2: Pointer): integer;
 
404
var
 
405
  Item1: TIdentifierListItem;
 
406
  Item2: TIdentifierListItem;
 
407
begin
 
408
  Item1:=TIdentifierListItem(Data1);
 
409
  Item2:=TIdentifierListItem(Data2);
 
410
  
 
411
  // first sort for Compatibility  (lower is better)
 
412
  if ord(Item1.Compatibility)<ord(Item2.Compatibility) then begin
 
413
    Result:=-1;
 
414
    exit;
 
415
  end else if ord(Item1.Compatibility)>ord(Item2.Compatibility) then begin
 
416
    Result:=1;
 
417
    exit;
 
418
  end;
 
419
  
 
420
  // then sort for History (lower is better)
 
421
  if Item1.HistoryIndex<Item2.HistoryIndex then begin
 
422
    Result:=-1;
 
423
    exit;
 
424
  end else if Item1.HistoryIndex>Item2.HistoryIndex then begin
 
425
    Result:=1;
 
426
    exit;
 
427
  end;
 
428
 
 
429
  // then sort for Level (lower is better)
 
430
  if Item1.Level<Item2.Level then begin
 
431
    Result:=-1;
 
432
    exit;
 
433
  end else if Item1.Level>Item2.Level then begin
 
434
    Result:=1;
 
435
    exit;
 
436
  end;
 
437
 
 
438
  // then sort alpabetically (lower is better)
 
439
  Result:=CompareIdentifierPtrs(Pointer(Item2.Identifier),Pointer(Item1.Identifier));
 
440
  if Result<>0 then exit;
 
441
  
 
442
  // then sort for ParamList (lower is better)
 
443
  Result:=Item2.CompareParamList(Item1);
 
444
end;
 
445
 
 
446
function CompareIdentListItemsForIdents(Data1, Data2: Pointer): integer;
 
447
var
 
448
  Item1: TIdentifierListItem;
 
449
  Item2: TIdentifierListItem;
 
450
begin
 
451
  Item1:=TIdentifierListItem(Data1);
 
452
  Item2:=TIdentifierListItem(Data2);
 
453
 
 
454
  // sort alpabetically (lower is better)
 
455
  Result:=CompareIdentifierPtrs(Pointer(Item2.Identifier),Pointer(Item1.Identifier));
 
456
  if Result<>0 then exit;
 
457
 
 
458
  // then sort for ParamList (lower is better)
 
459
  Result:=Item2.CompareParamList(Item1);
 
460
end;
 
461
 
 
462
function CompareIdentListSearchWithItems(SearchItem, Item: Pointer): integer;
 
463
var
 
464
  TheSearchItem: TIdentifierListSearchItem;
 
465
  TheItem: TIdentifierListItem;
 
466
begin
 
467
  TheSearchItem:=TIdentifierListSearchItem(SearchItem);
 
468
  TheItem:=TIdentifierListItem(Item);
 
469
 
 
470
  // sort alpabetically (lower is better)
 
471
  Result:=CompareIdentifierPtrs(Pointer(TheItem.Identifier),TheSearchItem.Identifier);
 
472
  if Result<>0 then exit;
 
473
 
 
474
  // then sort for ParamList (lower is better)
 
475
  Result:=TheItem.CompareParamList(TheSearchItem);
 
476
end;
 
477
 
 
478
function CompareIdentHistListItem(Data1, Data2: Pointer): integer;
 
479
var
 
480
  Item1: TIdentHistListItem;
 
481
  Item2: TIdentHistListItem;
 
482
begin
 
483
  Item1:=TIdentHistListItem(Data1);
 
484
  Item2:=TIdentHistListItem(Data2);
 
485
 
 
486
  Result:=CompareIdentifiers(PChar(Pointer(Item2.Identifier)),
 
487
                             PChar(Pointer(Item1.Identifier)));
 
488
  if Result<>0 then exit;
 
489
 
 
490
  //debugln('CompareIdentHistListItem ',Item2.Identifier,'=',Item1.Identifier);
 
491
  Result:=CompareIdentifiers(PChar(Pointer(Item2.ParamList)),
 
492
                             PChar(Pointer(Item1.ParamList)));
 
493
end;
 
494
 
 
495
function CompareIdentItemWithHistListItem(Data1, Data2: Pointer): integer;
 
496
var
 
497
  IdentItem: TIdentifierListItem;
 
498
  HistItem: TIdentHistListItem;
 
499
begin
 
500
  IdentItem:=TIdentifierListItem(Data1);
 
501
  HistItem:=TIdentHistListItem(Data2);
 
502
 
 
503
  Result:=CompareIdentifierPtrs(Pointer(HistItem.Identifier),
 
504
                                Pointer(IdentItem.Identifier));
 
505
  if Result<>0 then exit;
 
506
 
 
507
  //debugln('CompareIdentItemWithHistListItem ',HistItem.Identifier,'=',GetIdentifier(IdentItem.Identifier));
 
508
  Result:=SysUtils.CompareText(HistItem.ParamList,IdentItem.ParamTypeList);
 
509
end;
 
510
 
 
511
{ TIdentifierList }
 
512
 
 
513
procedure TIdentifierList.SetPrefix(const AValue: string);
 
514
begin
 
515
  if FPrefix=AValue then exit;
 
516
  FPrefix:=AValue;
 
517
  Include(FFlags,ilfFilteredListNeedsUpdate);
 
518
end;
 
519
 
 
520
procedure TIdentifierList.UpdateFilteredList;
 
521
var
 
522
  AnAVLNode: TAVLTreeNode;
 
523
  CurItem: TIdentifierListItem;
 
524
begin
 
525
  if not (ilfFilteredListNeedsUpdate in FFlags) then exit;
 
526
  if FFilteredList=nil then FFilteredList:=TFPList.Create;
 
527
  FFilteredList.Count:=0;
 
528
  FFilteredList.Capacity:=FItems.Count;
 
529
  {$IFDEF CTDEBUG}
 
530
  DebugLn(['TIdentifierList.UpdateFilteredList Prefix="',Prefix,'"']);
 
531
  {$ENDIF}
 
532
  AnAVLNode:=FItems.FindLowest;
 
533
  while AnAVLNode<>nil do begin
 
534
    CurItem:=TIdentifierListItem(AnAVLNode.Data);
 
535
    if (CurItem.Identifier<>'')
 
536
    and ComparePrefixIdent(PChar(Pointer(Prefix)),PChar(Pointer(CurItem.Identifier)))
 
537
    then begin
 
538
      {$IFDEF ShowFilteredIdents}
 
539
      DebugLn(['::: FILTERED ITEM ',FFilteredList.Count,' ',CurItem.Identifier]);
 
540
      {$ENDIF}
 
541
      if (length(Prefix)=length(CurItem.Identifier))
 
542
      and (not (iliAtCursor in CurItem.Flags)) then
 
543
        // put exact matches at the beginning
 
544
        FFilteredList.Insert(0,CurItem)
 
545
      else
 
546
        FFilteredList.Add(CurItem);
 
547
    end;
 
548
    AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
 
549
  end;
 
550
  {$IFDEF CTDEBUG}
 
551
  DebugLn(['TIdentifierList.UpdateFilteredList ',dbgs(FFilteredList.Count),' of ',dbgs(FItems.Count)]);
 
552
  {$ENDIF}
 
553
  Exclude(FFlags,ilfFilteredListNeedsUpdate);
 
554
end;
 
555
 
 
556
procedure TIdentifierList.SetHistory(const AValue: TIdentifierHistoryList);
 
557
begin
 
558
  if FHistory=AValue then exit;
 
559
  FHistory:=AValue;
 
560
end;
 
561
 
 
562
function TIdentifierList.GetFilteredItems(Index: integer): TIdentifierListItem;
 
563
begin
 
564
  UpdateFilteredList;
 
565
  if (Index<0) or (Index>=FFilteredList.Count) then
 
566
    Result:=nil
 
567
  else
 
568
    Result:=TIdentifierListItem(FFilteredList[Index]);
 
569
end;
 
570
 
 
571
constructor TIdentifierList.Create;
 
572
begin
 
573
  FFlags:=[ilfFilteredListNeedsUpdate];
 
574
  FItems:=TAVLTree.Create(@CompareIdentListItems);
 
575
  FIdentView:=TAVLTree.Create(@CompareIdentListItemsForIdents);
 
576
  FIdentSearchItem:=TIdentifierListSearchItem.Create;
 
577
  FCreatedIdentifiers:=TFPList.Create;
 
578
end;
 
579
 
 
580
destructor TIdentifierList.Destroy;
 
581
begin
 
582
  Clear;
 
583
  FreeAndNil(FUsedTools);
 
584
  FreeAndNil(FItems);
 
585
  FreeAndNil(FIdentView);
 
586
  FreeAndNil(FFilteredList);
 
587
  FreeAndNil(FIdentSearchItem);
 
588
  FreeAndNil(FCreatedIdentifiers);
 
589
  inherited Destroy;
 
590
end;
 
591
 
 
592
procedure TIdentifierList.Clear;
 
593
var
 
594
  i: Integer;
 
595
  p: Pointer;
 
596
begin
 
597
  fContextFlags:=[];
 
598
  fContext:=CleanFindContext;
 
599
  FNewMemberVisibility:=ctnNone;
 
600
  FStartBracketLvl:=0;
 
601
  fStartContext:=CleanFindContext;
 
602
  fStartContextPos.Code:=nil;
 
603
  fStartContextPos.X:=1;
 
604
  fStartContextPos.Y:=1;
 
605
  for i:=0 to FCreatedIdentifiers.Count-1 do begin
 
606
    p:=FCreatedIdentifiers[i];
 
607
    FreeMem(p);
 
608
  end;
 
609
  FCreatedIdentifiers.Clear;
 
610
  FItems.FreeAndClear;
 
611
  FIdentView.Clear;
 
612
  if FUsedTools<>nil then
 
613
    FUsedTools.Clear;
 
614
  FFlags:=FFlags+[ilfFilteredListNeedsUpdate,ilfUsedToolsNeedsUpdate];
 
615
end;
 
616
 
 
617
procedure TIdentifierList.Add(NewItem: TIdentifierListItem);
 
618
var
 
619
  AnAVLNode: TAVLTreeNode;
 
620
begin
 
621
  AnAVLNode:=FIdentView.FindKey(NewItem,@CompareIdentListItemsForIdents);
 
622
  if AnAVLNode=nil then begin
 
623
    if History<>nil then
 
624
      NewItem.HistoryIndex:=History.GetHistoryIndex(NewItem);
 
625
    FItems.Add(NewItem);
 
626
    FIdentView.Add(NewItem);
 
627
    FFlags:=FFlags+[ilfFilteredListNeedsUpdate,ilfUsedToolsNeedsUpdate];
 
628
  end else begin
 
629
    // redefined identifier -> ignore
 
630
    //DebugLn('TIdentifierList.Add redefined: ',NewItem.AsString);
 
631
    NewItem.Free;
 
632
  end;
 
633
end;
 
634
 
 
635
function TIdentifierList.Count: integer;
 
636
begin
 
637
  Result:=FItems.Count;
 
638
end;
 
639
 
 
640
function TIdentifierList.GetFilteredCount: integer;
 
641
begin
 
642
  UpdateFilteredList;
 
643
  Result:=FFilteredList.Count;
 
644
end;
 
645
 
 
646
function TIdentifierList.HasIdentifier(Identifier: PChar;
 
647
  const ParamList: string): boolean;
 
648
begin
 
649
  FIdentSearchItem.Identifier:=Identifier;
 
650
  FIdentSearchItem.ParamList:=ParamList;
 
651
  Result:=FIdentView.FindKey(FIdentSearchItem,
 
652
                             @CompareIdentListSearchWithItems)<>nil;
 
653
end;
 
654
 
 
655
function TIdentifierList.FindIdentifier(Identifier: PChar;
 
656
  const ParamList: string): TIdentifierListItem;
 
657
var
 
658
  AVLNode: TAVLTreeNode;
 
659
begin
 
660
  FIdentSearchItem.Identifier:=Identifier;
 
661
  FIdentSearchItem.ParamList:=ParamList;
 
662
  AVLNode:=FIdentView.FindKey(FIdentSearchItem,@CompareIdentListSearchWithItems);
 
663
  if AVLNode<>nil then
 
664
    Result:=TIdentifierListItem(AVLNode.Data)
 
665
  else
 
666
    Result:=nil;
 
667
end;
 
668
 
 
669
function TIdentifierList.FindCreatedIdentifier(const Ident: string): integer;
 
670
begin
 
671
  if Ident<>'' then begin
 
672
    Result:=FCreatedIdentifiers.Count-1;
 
673
    while (Result>=0)
 
674
    and (CompareIdentifiers(PChar(Pointer(Ident)),
 
675
                            PChar(Pointer(FCreatedIdentifiers[Result])))<>0)
 
676
    do
 
677
      dec(Result);
 
678
  end else begin
 
679
    Result:=-1;
 
680
  end;
 
681
end;
 
682
 
 
683
function TIdentifierList.CreateIdentifier(const Ident: string): PChar;
 
684
var
 
685
  i: Integer;
 
686
begin
 
687
  if Ident<>'' then begin
 
688
    i:=FindCreatedIdentifier(Ident);
 
689
    if i>=0 then
 
690
      Result:=PChar(Pointer(FCreatedIdentifiers[i]))
 
691
    else begin
 
692
      GetMem(Result,length(Ident)+1);
 
693
      Move(Ident[1],Result^,length(Ident)+1);
 
694
      FCreatedIdentifiers.Add(Result);
 
695
    end;
 
696
  end else
 
697
    Result:=nil;
 
698
end;
 
699
 
 
700
function TIdentifierList.StartUpAtomInFrontIs(const s: string): boolean;
 
701
begin
 
702
  Result:=StartContext.Tool.FreeUpAtomIs(StartAtomInFront,s);
 
703
end;
 
704
 
 
705
function TIdentifierList.StartUpAtomBehindIs(const s: string): boolean;
 
706
begin
 
707
  Result:=StartContext.Tool.FreeUpAtomIs(StartAtomBehind,s);
 
708
end;
 
709
 
 
710
function TIdentifierList.CompletePrefix(const OldPrefix: string): string;
 
711
// search all identifiers beginning with Prefix
 
712
// and return the biggest prefix of all of them
 
713
var
 
714
  AnAVLNode: TAVLTreeNode;
 
715
  CurItem: TIdentifierListItem;
 
716
  FoundFirst: Boolean;
 
717
  SamePos: Integer;
 
718
  l: Integer;
 
719
begin
 
720
  Result:=Prefix;
 
721
  FoundFirst:=false;
 
722
  AnAVLNode:=FItems.FindLowest;
 
723
  while AnAVLNode<>nil do begin
 
724
    CurItem:=TIdentifierListItem(AnAVLNode.Data);
 
725
    if (CurItem.Identifier<>'')
 
726
    and ComparePrefixIdent(PChar(Pointer(Prefix)),PChar(Pointer(CurItem.Identifier)))
 
727
    and (not (iliAtCursor in CurItem.Flags))
 
728
    then begin
 
729
      if not FoundFirst then begin
 
730
        Result:=CurItem.Identifier;
 
731
        FoundFirst:=true;
 
732
      end else begin
 
733
        SamePos:=length(Prefix)+1;
 
734
        l:=length(Result);
 
735
        if l>length(CurItem.Identifier) then
 
736
          l:=length(CurItem.Identifier);
 
737
        while (SamePos<=l)
 
738
        and (UpChars[CurItem.Identifier[SamePos]]=UpChars[Result[SamePos]])
 
739
        do
 
740
          inc(SamePos);
 
741
        if SamePos<=length(Result) then begin
 
742
          Result:=copy(Result,1,SamePos-1);
 
743
          if length(Result)=length(Prefix) then exit;
 
744
        end;
 
745
      end;
 
746
    end;
 
747
    AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
 
748
  end;
 
749
end;
 
750
 
 
751
function TIdentifierList.CalcMemSize: PtrUInt;
 
752
var
 
753
  i: Integer;
 
754
  Node: TAVLTreeNode;
 
755
  li: TIdentifierListItem;
 
756
  hli: TIdentHistListItem;
 
757
begin
 
758
  Result:=PtrUInt(InstanceSize)
 
759
    +MemSizeString(FPrefix);
 
760
  if FCreatedIdentifiers<>nil then begin
 
761
    inc(Result,MemSizeFPList(FCreatedIdentifiers));
 
762
    for i:=0 to FCreatedIdentifiers.Count-1 do
 
763
      inc(Result,GetIdentLen(PChar(FCreatedIdentifiers[i])));
 
764
  end;
 
765
  if FFilteredList<>nil then begin
 
766
    inc(Result,MemSizeFPList(FFilteredList));
 
767
    for i:=0 to FFilteredList.Count-1 do
 
768
      inc(Result,TIdentifierListItem(FFilteredList[i]).CalcMemSize);
 
769
  end;
 
770
  if FHistory<>nil then begin
 
771
    inc(Result,FHistory.CalcMemSize);
 
772
  end;
 
773
  if FItems<>nil then begin
 
774
    inc(Result,FItems.Count*SizeOf(TAVLTreeNode));
 
775
    Node:=FItems.FindLowest;
 
776
    while Node<>nil do begin
 
777
      li:=TIdentifierListItem(Node.Data);
 
778
      inc(Result,li.CalcMemSize);
 
779
      Node:=FItems.FindSuccessor(Node);
 
780
    end;
 
781
  end;
 
782
  if FIdentView<>nil then begin
 
783
    inc(Result,FIdentView.Count*SizeOf(TAVLTreeNode));
 
784
    Node:=FIdentView.FindLowest;
 
785
    while Node<>nil do begin
 
786
      hli:=TIdentHistListItem(Node.Data);
 
787
      inc(Result,hli.CalcMemSize);
 
788
      Node:=FIdentView.FindSuccessor(Node);
 
789
    end;
 
790
  end;
 
791
  if FIdentSearchItem<>nil then
 
792
    inc(Result,FIdentSearchItem.CalcMemSize);
 
793
end;
 
794
 
 
795
{ TIdentCompletionTool }
 
796
 
 
797
procedure TIdentCompletionTool.AddToTreeOfUnitFileInfo(const AFilename: string);
 
798
begin
 
799
  AddToTreeOfUnitFiles(FIDTTreeOfUnitFiles,AFilename,false);
 
800
end;
 
801
 
 
802
function TIdentCompletionTool.CollectAllIdentifiers(
 
803
  Params: TFindDeclarationParams; const FoundContext: TFindContext
 
804
  ): TIdentifierFoundResult;
 
805
var
 
806
  Ident: PChar;
 
807
  CurContextParent: TCodeTreeNode;
 
808
 
 
809
  function ProtectedNodeIsInAllowedClass: boolean;
 
810
  var
 
811
    CurClassNode: TCodeTreeNode;
 
812
    FoundClassContext: TFindContext;
 
813
  begin
 
814
    Result:=false;
 
815
    if FICTClassAndAncestors<>nil then begin
 
816
      // start of the identifier completion is in a method or class
 
817
      // => all protected ancestor classes are allowed as well.
 
818
      CurClassNode:=FoundContext.Node;
 
819
      while (CurClassNode<>nil)
 
820
      and (not (CurClassNode.Desc in AllClasses)) do
 
821
        CurClassNode:=CurClassNode.Parent;
 
822
      if CurClassNode=nil then exit;
 
823
      FoundClassContext:=CreateFindContext(Params.NewCodeTool,CurClassNode);
 
824
      if IndexOfFindContext(FICTClassAndAncestors,@FoundClassContext)>=0 then begin
 
825
        // this class node is the class or one of the ancestors of the class
 
826
        // of the start context of the identifier completion
 
827
        exit(true);
 
828
      end;
 
829
    end;
 
830
    //DebugLn(['ProtectedNodeIsInAllowedClass hidden: ',FindContextToString(FoundContext)]);
 
831
  end;
 
832
  
 
833
  function PropertyIsOverridenPublicPublish: boolean;
 
834
  begin
 
835
    // protected properties can be made public in child classes.
 
836
    //debugln('PropertyIsOverridenPublicPublish Identifier=',GetIdentifier(Ident),' Find=',dbgs((FIDCTFoundPublicProperties<>nil) and (FIDCTFoundPublicProperties.Find(Ident)<>nil)));
 
837
    if FIDCTFoundPublicProperties<>nil then begin
 
838
      if FIDCTFoundPublicProperties.Find(Ident)<>nil then begin
 
839
        // there is a public/published property with the same name
 
840
        exit(true);
 
841
      end;
 
842
    end;
 
843
    Result:=false;
 
844
  end;
 
845
  
 
846
  procedure SavePublicPublishedProperty;
 
847
  begin
 
848
    if FIDCTFoundPublicProperties=nil then begin
 
849
      // create tree
 
850
      FIDCTFoundPublicProperties:=
 
851
                         TAVLTree.Create(TListSortCompare(@CompareIdentifiers))
 
852
    end else if FIDCTFoundPublicProperties.Find(Ident)<>nil then begin
 
853
      // identifier is already public
 
854
      exit;
 
855
    end;
 
856
    FIDCTFoundPublicProperties.Add(Ident);
 
857
    //debugln('SavePublicPublishedProperty Identifier=',GetIdentifier(Ident),' Find=',dbgs(FIDCTFoundPublicProperties.Find(Ident)<>nil));
 
858
  end;
 
859
  
 
860
var
 
861
  NewItem: TIdentifierListItem;
 
862
  Node: TCodeTreeNode;
 
863
  ProtectedForeignClass: Boolean;
 
864
  Lvl: LongInt;
 
865
  NamePos: TAtomPosition;
 
866
begin
 
867
  // proceed searching ...
 
868
  Result:=ifrProceedSearch;
 
869
 
 
870
  {$IFDEF ShowFoundIdents}
 
871
  if FoundContext.Tool=Self then
 
872
  DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
 
873
    ' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"'
 
874
    ,' '+dbgs(fdfIgnoreUsedUnits in Params.Flags));
 
875
  {$ENDIF}
 
876
 
 
877
  CurContextParent:=FoundContext.Node.GetFindContextParent;
 
878
  if FLastGatheredIdentParent<>CurContextParent then begin
 
879
    // new context level
 
880
    FLastGatheredIdentParent:=CurContextParent;
 
881
    inc(FLastGatheredIdentLevel);
 
882
  end;
 
883
 
 
884
  Lvl:=FLastGatheredIdentLevel;
 
885
 
 
886
  ProtectedForeignClass:=false;
 
887
  if FoundContext.Tool=Self then begin
 
888
    // identifier is in the same unit
 
889
    //DebugLn('::: COLLECT IDENT in SELF ',FoundContext.Node.DescAsString,
 
890
    //  ' "',dbgstr(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"'
 
891
    //  ,' fdfIgnoreUsedUnits='+dbgs(fdfIgnoreUsedUnits in Params.Flags));
 
892
    if (FoundContext.Node=CurrentIdentifierList.StartContext.Node)
 
893
    or (FoundContext.Node=CurrentIdentifierList.Context.Node)
 
894
    or (FoundContext.Node.StartPos=CurrentIdentifierList.StartAtom.StartPos)
 
895
    then begin
 
896
      // found identifier is in cursor node
 
897
      // => do not show it
 
898
      exit;
 
899
    end;
 
900
  end else begin
 
901
    // identifier is in another unit
 
902
    Node:=FoundContext.Node.Parent;
 
903
    if (Node<>nil) and (Node.Desc in AllClassSubSections) then
 
904
      Node:=Node.Parent;
 
905
    if (Node<>nil) and (Node.Desc in AllClassBaseSections) then begin
 
906
      //debugln(['TIdentCompletionTool.CollectAllIdentifiers Node=',Node.DescAsString,' Context=',CurrentIdentifierList.Context.Node.DescAsString,' CtxVis=',NodeDescToStr(CurrentIdentifierList.NewMemberVisibility)]);
 
907
      if (CurrentIdentifierList.NewMemberVisibility<>ctnNone)
 
908
      and (CurrentIdentifierList.NewMemberVisibility<Node.Desc)
 
909
      and (CurrentIdentifierList.Context.Node.Desc
 
910
        in ([ctnProcedure,ctnProcedureHead,ctnProperty]+AllClassSections))
 
911
      then begin
 
912
        // the user wants to override a method or property
 
913
        // => ignore all with a higher visibility, because fpc does not allow
 
914
        //    to downgrade the visibility and will give a hint when trying
 
915
        //debugln(['TIdentCompletionTool.CollectAllIdentifiers skipping member, because it would downgrade: ',dbgstr(FoundContext.Tool.ExtractNode(FoundContext.Node,[]),1,30)]);
 
916
        exit;
 
917
      end;
 
918
      case Node.Desc of
 
919
      ctnClassPrivate:
 
920
        begin
 
921
          // skip private definitions in other units
 
922
          exit;
 
923
        end;
 
924
      ctnClassProtected:
 
925
        begin
 
926
          // protected definitions are only accessible from descendants
 
927
          // or if visibility was raised (e.g. property)
 
928
          if ProtectedNodeIsInAllowedClass then begin
 
929
            // protected node in an ancestor => allowed
 
930
            //debugln('TIdentCompletionTool.CollectAllIdentifiers ALLOWED Protected in ANCESTOR '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
 
931
          end else if (FoundContext.Node.Desc=ctnProperty) then begin
 
932
            // protected property: maybe the visibility was raised => continue
 
933
            ProtectedForeignClass:=true;
 
934
            //debugln('TIdentCompletionTool.CollectAllIdentifiers MAYBE Protected made Public '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
 
935
          end else begin
 
936
            // otherwise: treat as private
 
937
            //debugln('TIdentCompletionTool.CollectAllIdentifiers FORBIDDEN Protected '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
 
938
            exit;
 
939
          end;
 
940
        end;
 
941
      end;
 
942
    end;
 
943
  end;
 
944
 
 
945
  Ident:=nil;
 
946
  case FoundContext.Node.Desc of
 
947
  
 
948
  ctnTypeDefinition,ctnGenericType:
 
949
    begin
 
950
      Node:=FoundContext.Node.FirstChild;
 
951
      if FoundContext.Node.Desc=ctnTypeDefinition then
 
952
        Ident:=@FoundContext.Tool.Src[FoundContext.Node.StartPos]
 
953
      else begin
 
954
        // generic
 
955
        if Node=nil then exit;
 
956
        Ident:=@FoundContext.Tool.Src[Node.StartPos];
 
957
      end;
 
958
      if Node=nil then begin
 
959
        // type without definition
 
960
      end;
 
961
      if (Node<>nil)
 
962
      and (Node.Desc in AllClasses)
 
963
      and ((ctnsForwardDeclaration and Node.SubDesc)>0)
 
964
      then begin
 
965
        // forward definition of a class
 
966
        if CurrentIdentifierList.FindIdentifier(Ident,'')<>nil then begin
 
967
          // the real class is already in the list => skip forward
 
968
          exit;
 
969
        end;
 
970
      end;
 
971
    end;
 
972
  
 
973
  ctnVarDefinition,ctnConstDefinition,ctnEnumIdentifier:
 
974
    Ident:=@FoundContext.Tool.Src[FoundContext.Node.StartPos];
 
975
    
 
976
  ctnProcedure,ctnProcedureHead:
 
977
    Ident:=FoundContext.Tool.GetProcNameIdentifier(FoundContext.Node);
 
978
    
 
979
  ctnProperty:
 
980
    begin
 
981
      Ident:=FoundContext.Tool.GetPropertyNameIdentifier(FoundContext.Node);
 
982
      if FoundContext.Tool.PropNodeIsTypeLess(FoundContext.Node) then begin
 
983
        if FoundContext.Node.Parent.Desc in [ctnClassPublic,ctnClassPublished]
 
984
        then
 
985
          SavePublicPublishedProperty;
 
986
        // do not show properties without types (e.g. property Color;)
 
987
        // only show the real definition, which will follow in the ancestor
 
988
        exit;
 
989
      end;
 
990
      if (FoundContext.Node.Parent.Desc=ctnClassPrivate)
 
991
      and (FoundContext.Tool<>Self)
 
992
      and (not PropertyIsOverridenPublicPublish) then begin
 
993
        // a private property in another unit, that was not
 
994
        // made public/publish later
 
995
        // => skip
 
996
        exit;
 
997
      end;
 
998
      if (FoundContext.Node.Parent.Desc=ctnClassProtected)
 
999
      and ProtectedForeignClass
 
1000
      and (not PropertyIsOverridenPublicPublish) then begin
 
1001
        // a protected property in another unit, that was not
 
1002
        // made public/publish later
 
1003
        // => skip
 
1004
        exit;
 
1005
      end;
 
1006
    end;
 
1007
    
 
1008
  ctnRecordCase:
 
1009
    Ident:=@FoundContext.Tool.Src[Params.NewCleanPos];
 
1010
 
 
1011
  ctnUseUnit:
 
1012
    if (FoundContext.Tool=Self) then begin
 
1013
      Ident:=@Src[FoundContext.Node.StartPos];
 
1014
    end;
 
1015
 
 
1016
  ctnUnit,ctnProgram,ctnLibrary,ctnPackage:
 
1017
    if (FoundContext.Tool=Self)
 
1018
    and GetSourceNamePos(NamePos) then
 
1019
      Ident:=@Src[NamePos.StartPos];
 
1020
 
 
1021
  end;
 
1022
  if Ident=nil then exit;
 
1023
 
 
1024
  NewItem:=TIdentifierListItem.Create(
 
1025
                            icompUnknown,
 
1026
                            false,
 
1027
                            0,
 
1028
                            Ident,
 
1029
                            Lvl,
 
1030
                            FoundContext.Node,
 
1031
                            FoundContext.Tool,
 
1032
                            ctnNone);
 
1033
  if (FoundContext.Node=CurrentIdentifierList.StartContext.Node) then begin
 
1034
    // found identifier is in cursor node
 
1035
    Include(NewItem.Flags,iliAtCursor);
 
1036
  end;
 
1037
 
 
1038
  {$IFDEF ShowFoundIdents}
 
1039
  if FoundContext.Tool=Self then
 
1040
  DebugLn('  IDENT COLLECTED: ',NewItem.AsString);
 
1041
  {$ENDIF}
 
1042
  
 
1043
  CurrentIdentifierList.Add(NewItem);
 
1044
end;
 
1045
 
 
1046
procedure TIdentCompletionTool.GatherPredefinedIdentifiers(CleanPos: integer;
 
1047
  const Context: TFindContext; BeautifyCodeOptions: TBeautifyCodeOptions);
 
1048
// Add predefined identifiers
 
1049
const
 
1050
  CompilerFuncHistoryIndex = 10;
 
1051
  CompilerFuncLevel = 10;
 
1052
 
 
1053
  function StatementLevel: integer;
 
1054
  var
 
1055
    ANode: TCodeTreeNode;
 
1056
  begin
 
1057
    Result:=0;
 
1058
    ANode:=Context.Node;
 
1059
    while (ANode<>nil) and (not (ANode.Desc in [ctnBeginBlock,ctnAsmBlock])) do
 
1060
    begin
 
1061
      ANode:=ANode.Parent;
 
1062
      inc(Result);
 
1063
    end;
 
1064
    if ANode=nil then Result:=0;
 
1065
  end;
 
1066
  
 
1067
  procedure AddCompilerProcedure(const AProcName, AParameterList: PChar);
 
1068
  var
 
1069
    NewItem: TIdentifierListItem;
 
1070
  begin
 
1071
    //DebugLn(['AddCompilerProcedure ',AProcName,' ',ilcfStartOfStatement in CurrentIdentifierList.ContextFlags]);
 
1072
    if not (ilcfStartOfStatement in CurrentIdentifierList.ContextFlags) then exit;
 
1073
    if not (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags) then exit;
 
1074
 
 
1075
    NewItem:=TIdentifierListItem.Create(
 
1076
        icompUnknown,
 
1077
        false,
 
1078
        CompilerFuncHistoryIndex,
 
1079
        AProcName,
 
1080
        CompilerFuncLevel,
 
1081
        nil,
 
1082
        nil,
 
1083
        ctnProcedure);
 
1084
    NewItem.ParamTypeList:=AParameterList;
 
1085
    NewItem.ParamNameList:=AParameterList;
 
1086
    NewItem.Flags:=NewItem.Flags+[iliParamTypeListValid,iliParamNameListValid];
 
1087
    CurrentIdentifierList.Add(NewItem);
 
1088
  end;
 
1089
  
 
1090
  procedure AddCompilerFunction(const AProcName, AParameterList,
 
1091
    AResultType: PChar);
 
1092
  var
 
1093
    NewItem: TIdentifierListItem;
 
1094
  begin
 
1095
    if not (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags) then exit;
 
1096
 
 
1097
    NewItem:=TIdentifierListItem.Create(
 
1098
        icompUnknown,
 
1099
        false,
 
1100
        CompilerFuncHistoryIndex,
 
1101
        AProcName,
 
1102
        CompilerFuncLevel,
 
1103
        nil,
 
1104
        nil,
 
1105
        ctnProcedure);
 
1106
    NewItem.ParamTypeList:=AParameterList;
 
1107
    NewItem.ParamNameList:=AParameterList;
 
1108
    NewItem.ResultType:=AResultType;
 
1109
    NewItem.Flags:=NewItem.Flags+[iliParamTypeListValid,iliParamNameListValid,
 
1110
                           iliIsFunction,iliIsFunctionValid,iliResultTypeValid];
 
1111
    CurrentIdentifierList.Add(NewItem);
 
1112
  end;
 
1113
 
 
1114
  procedure AddBaseType(const BaseName: PChar);
 
1115
  var
 
1116
    NewItem: TIdentifierListItem;
 
1117
  begin
 
1118
    NewItem:=TIdentifierListItem.Create(
 
1119
        icompUnknown,
 
1120
        false,
 
1121
        CompilerFuncHistoryIndex,
 
1122
        BaseName,
 
1123
        CompilerFuncLevel,
 
1124
        nil,
 
1125
        nil,
 
1126
        ctnTypeDefinition);
 
1127
    CurrentIdentifierList.Add(NewItem);
 
1128
  end;
 
1129
 
 
1130
  procedure AddBaseConstant(const BaseName: PChar);
 
1131
  var
 
1132
    NewItem: TIdentifierListItem;
 
1133
  begin
 
1134
    NewItem:=TIdentifierListItem.Create(
 
1135
        icompUnknown,
 
1136
        false,
 
1137
        CompilerFuncHistoryIndex,
 
1138
        BaseName,
 
1139
        CompilerFuncLevel,
 
1140
        nil,
 
1141
        nil,
 
1142
        ctnConstant);
 
1143
    CurrentIdentifierList.Add(NewItem);
 
1144
  end;
 
1145
 
 
1146
  procedure AddSystemUnit(const AnUnitName: PChar);
 
1147
  var
 
1148
    NewItem: TIdentifierListItem;
 
1149
  begin
 
1150
    NewItem:=TIdentifierListItem.Create(
 
1151
        icompUnknown,
 
1152
        false,
 
1153
        CompilerFuncHistoryIndex,
 
1154
        AnUnitName,
 
1155
        CompilerFuncLevel,
 
1156
        nil,
 
1157
        nil,
 
1158
        ctnUseUnit);
 
1159
    CurrentIdentifierList.Add(NewItem);
 
1160
  end;
 
1161
 
 
1162
var
 
1163
  NewItem: TIdentifierListItem;
 
1164
  ProcNode: TCodeTreeNode;
 
1165
  HidddnUnits: String;
 
1166
  p: PChar;
 
1167
begin
 
1168
  if not (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags) then exit;
 
1169
 
 
1170
  if Context.Node.Desc in AllPascalStatements then begin
 
1171
    // see fpc/compiler/psystem.pp
 
1172
    AddCompilerProcedure('Assert','Condition:Boolean;const Message:String');
 
1173
    AddCompilerFunction('Assigned','P:Pointer','Boolean');
 
1174
    AddCompilerFunction('Addr','var X','Pointer');
 
1175
    AddCompilerFunction('BitSizeOf','Identifier','Integer');
 
1176
    AddCompilerProcedure('Break','');
 
1177
    AddCompilerFunction('Concat','S1:String;S2:String[...;Sn:String]', 'String');
 
1178
    AddCompilerProcedure('Continue','');
 
1179
    AddCompilerFunction('Copy','const S:String;FromPosition,Count:Integer', 'String');
 
1180
    AddCompilerProcedure('Dec','var X:Ordinal;N:Integer=1');
 
1181
    AddCompilerProcedure('Dispose','var X:Pointer');
 
1182
    AddCompilerProcedure('Exclude','var S:Set;X:Ordinal');
 
1183
    AddCompilerProcedure('Exit','');
 
1184
    AddCompilerProcedure('Finalize','var X');
 
1185
    AddCompilerFunction('get_frame','','Pointer');
 
1186
    AddCompilerFunction('High','Arg:TypeOrVariable','Ordinal');
 
1187
    AddCompilerProcedure('Inc','var X:Ordinal;N:Integer=1');
 
1188
    AddCompilerProcedure('Include','var S:Set;X:Ordinal');
 
1189
    AddCompilerProcedure('Initialize','var X');
 
1190
    AddCompilerFunction('Length','S:String','Ordinal');
 
1191
    AddCompilerFunction('Length','A:Array','Ordinal');
 
1192
    AddCompilerFunction('Low','Arg:TypeOrVariable','Ordinal');
 
1193
    AddCompilerProcedure('New','var X:Pointer');
 
1194
    AddCompilerFunction('ObjCSelector','String','SEL');
 
1195
    AddCompilerFunction('Ofs','var X','LongInt');
 
1196
    AddCompilerFunction('Ord','X:Ordinal', 'Integer');
 
1197
    AddCompilerProcedure('Pack','A:Array;N:Integer;var A:Array');
 
1198
    AddCompilerFunction('Pred','X:Ordinal', 'Ordinal');
 
1199
    AddCompilerProcedure('Read','');
 
1200
    AddCompilerProcedure('ReadLn','');
 
1201
    AddCompilerProcedure('ReadStr','S:String;var Args:Arguments');
 
1202
    AddCompilerFunction('Seg','var X','LongInt');
 
1203
    AddCompilerProcedure('SetLength','var S:String;NewLength:Integer');
 
1204
    AddCompilerProcedure('SetLength','var A:Array;NewLength:Integer');
 
1205
    AddCompilerFunction('SizeOf','Identifier','Integer');
 
1206
    AddCompilerFunction('Slice','var A:Array;Count:Integer','Array');
 
1207
    AddCompilerProcedure('Str','const X[:Width[:Decimals]];var S:String');
 
1208
    AddCompilerFunction('Succ','X:Ordinal', 'Ordinal');
 
1209
    AddCompilerFunction('TypeInfo','Identifier', 'Pointer');
 
1210
    AddCompilerFunction('TypeOf','Identifier', 'Pointer');
 
1211
    AddCompilerProcedure('Val','S:String;var V;var Code:Integer');
 
1212
    AddCompilerFunction('Unaligned','var X','var'); // Florian declaration :)
 
1213
    AddCompilerProcedure('Unpack','A:Array;var A:Array;N:Integer');
 
1214
    AddCompilerProcedure('Write','Args:Arguments');
 
1215
    AddCompilerProcedure('WriteLn','Args:Arguments');
 
1216
    AddCompilerProcedure('WriteStr','var S:String;Args:Arguments');
 
1217
 
 
1218
    if (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags)
 
1219
    and Context.Tool.NodeIsInAMethod(Context.Node)
 
1220
    and (not CurrentIdentifierList.HasIdentifier('Self','')) then begin
 
1221
      // method body -> add 'Self'
 
1222
      NewItem:=TIdentifierListItem.Create(
 
1223
          icompUnknown,
 
1224
          true,
 
1225
          1,
 
1226
          'Self',
 
1227
          StatementLevel,
 
1228
          nil,
 
1229
          nil,
 
1230
          ctnVarDefinition);
 
1231
      CurrentIdentifierList.Add(NewItem);
 
1232
    end;
 
1233
    ProcNode:=Context.Node.GetNodeOfType(ctnProcedure);
 
1234
    if (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags)
 
1235
    and Context.Tool.NodeIsFunction(ProcNode)
 
1236
    and (not CurrentIdentifierList.HasIdentifier('Result','')) then begin
 
1237
      // function body -> add 'Result'
 
1238
      NewItem:=TIdentifierListItem.Create(
 
1239
          icompUnknown,
 
1240
          true,
 
1241
          1,
 
1242
          'Result',
 
1243
          StatementLevel,
 
1244
          nil,
 
1245
          nil,
 
1246
          ctnVarDefinition);
 
1247
      CurrentIdentifierList.Add(NewItem);
 
1248
    end;
 
1249
  end;
 
1250
 
 
1251
  // system types
 
1252
  AddBaseType('Char');
 
1253
  AddBaseType('WideChar');
 
1254
  AddBaseType('Real');
 
1255
  AddBaseType('Single');
 
1256
  AddBaseType('Double');
 
1257
  AddBaseType('Extended');
 
1258
  AddBaseType('CExtended');
 
1259
  AddBaseType('Currency');
 
1260
  AddBaseType('Comp');
 
1261
  AddBaseType('Int64');
 
1262
  AddBaseType('Cardinal');
 
1263
  AddBaseType('QWord');
 
1264
  AddBaseType('Boolean');
 
1265
  AddBaseType('ByteBool');
 
1266
  AddBaseType('WordBool');
 
1267
  AddBaseType('LongBool');
 
1268
  AddBaseType('QWordBool');
 
1269
  AddBaseType('String');
 
1270
  AddBaseType('AnsiString');
 
1271
  AddBaseType('ShortString');
 
1272
  AddBaseType('WideString');
 
1273
  AddBaseType('UnicodeString');
 
1274
  AddBaseType('Pointer');
 
1275
  AddBaseType('Word');
 
1276
  AddBaseType('SmallInt');
 
1277
  AddBaseType('ShortInt');
 
1278
  AddBaseType('Byte');
 
1279
  if not (ilcfStartInStatement in CurrentIdentifierList.ContextFlags) then begin
 
1280
    AddBaseType('File');
 
1281
    AddBaseType('Text');
 
1282
  end;
 
1283
  AddBaseConstant('Nil');
 
1284
  AddBaseConstant('True');
 
1285
  AddBaseConstant('False');
 
1286
 
 
1287
  // system units
 
1288
  HidddnUnits:=Scanner.GetHiddenUsedUnits;
 
1289
  if HidddnUnits<>'' then begin
 
1290
    p:=PChar(HidddnUnits);
 
1291
    while p^<>#0 do begin
 
1292
      while p^=',' do inc(p);
 
1293
      if GetIdentLen(p)>0 then
 
1294
        AddSystemUnit(p);
 
1295
      while not (p^ in [',',#0]) do inc(p);
 
1296
    end;
 
1297
  end;
 
1298
end;
 
1299
 
 
1300
procedure TIdentCompletionTool.GatherUsefulIdentifiers(CleanPos: integer;
 
1301
  const Context: TFindContext; BeautifyCodeOptions: TBeautifyCodeOptions);
 
1302
var
 
1303
  NewItem: TIdentifierListItem;
 
1304
  PropertyName: String;
 
1305
begin
 
1306
  while (CleanPos>1) and (IsIdentChar[Src[CleanPos-1]]) do dec(CleanPos);
 
1307
  GatherPredefinedIdentifiers(CleanPos,Context,BeautifyCodeOptions);
 
1308
  if Context.Node.Desc=ctnProperty then begin
 
1309
    PropertyName:=ExtractPropName(Context.Node,false);
 
1310
    //debugln('TIdentCompletionTool.GatherUsefulIdentifiers Property ',PropertyName);
 
1311
    MoveCursorToCleanPos(CleanPos);
 
1312
    ReadPriorAtom;
 
1313
    if UpAtomIs('READ') then begin
 
1314
      // add the default class completion 'read' specifier function
 
1315
      NewItem:=TIdentifierListItem.Create(
 
1316
          icompUnknown,true,0,
 
1317
          CurrentIdentifierList.CreateIdentifier(
 
1318
            BeautifyCodeOptions.PropertyReadIdentPrefix+PropertyName),
 
1319
          0,nil,nil,ctnProcedure);
 
1320
      CurrentIdentifierList.Add(NewItem);
 
1321
    end;
 
1322
    if UpAtomIs('WRITE') then begin
 
1323
      // add the default class completion 'write' specifier function
 
1324
      NewItem:=TIdentifierListItem.Create(
 
1325
          icompUnknown,true,0,
 
1326
          CurrentIdentifierList.CreateIdentifier(
 
1327
            BeautifyCodeOptions.PropertyWriteIdentPrefix+PropertyName),
 
1328
          0,nil,nil,ctnProcedure);
 
1329
      CurrentIdentifierList.Add(NewItem);
 
1330
    end;
 
1331
    if (UpAtomIs('READ') or UpAtomIs('WRITE'))
 
1332
    and (Context.Tool.FindClassOrInterfaceNode(Context.Node)<>nil)
 
1333
    then begin
 
1334
      // add the default class completion 'read'/'write' specifier variable
 
1335
      NewItem:=TIdentifierListItem.Create(
 
1336
          icompUnknown,true,0,
 
1337
          CurrentIdentifierList.CreateIdentifier(
 
1338
            BeautifyCodeOptions.PrivateVariablePrefix+PropertyName),
 
1339
          0,nil,nil,ctnVarDefinition);
 
1340
      CurrentIdentifierList.Add(NewItem);
 
1341
    end;
 
1342
    if UpAtomIs('STORED') then begin
 
1343
      // add the default class completion 'stored' specifier function
 
1344
      NewItem:=TIdentifierListItem.Create(
 
1345
          icompUnknown,true,0,
 
1346
          CurrentIdentifierList.CreateIdentifier(
 
1347
            PropertyName+BeautifyCodeOptions.PropertyStoredIdentPostfix),
 
1348
          0,nil,nil,ctnProcedure);
 
1349
      CurrentIdentifierList.Add(NewItem);
 
1350
    end;
 
1351
  end;
 
1352
end;
 
1353
 
 
1354
procedure TIdentCompletionTool.GatherUnitnames;
 
1355
 
 
1356
  procedure GatherUnitsFromSet;
 
1357
  begin
 
1358
    // collect all unit files in fpc unit paths
 
1359
    DirectoryCache.IterateFPCUnitsInSet(@AddToTreeOfUnitFileInfo);
 
1360
  end;
 
1361
 
 
1362
var
 
1363
  UnitPath, SrcPath: string;
 
1364
  BaseDir: String;
 
1365
  ANode: TAVLTreeNode;
 
1366
  UnitFileInfo: TUnitFileInfo;
 
1367
  NewItem: TIdentifierListItem;
 
1368
  UnitExt: String;
 
1369
  SrcExt: String;
 
1370
  CurSourceName: String;
 
1371
begin
 
1372
  UnitPath:='';
 
1373
  SrcPath:='';
 
1374
  GatherUnitAndSrcPath(UnitPath,SrcPath);
 
1375
  //DebugLn('TIdentCompletionTool.GatherUnitnames UnitPath="',UnitPath,'" SrcPath="',SrcPath,'"');
 
1376
  BaseDir:=ExtractFilePath(MainFilename);
 
1377
  FIDTTreeOfUnitFiles:=nil;
 
1378
  try
 
1379
    // search in unitpath
 
1380
    UnitExt:='pp;pas;ppu';
 
1381
    if Scanner.CompilerMode=cmMacPas then
 
1382
      UnitExt:=UnitExt+';p';
 
1383
    GatherUnitFiles(BaseDir,UnitPath,UnitExt,false,true,FIDTTreeOfUnitFiles);
 
1384
    // search in srcpath
 
1385
    SrcExt:='pp;pas';
 
1386
    if Scanner.CompilerMode=cmMacPas then
 
1387
      SrcExt:=SrcExt+';p';
 
1388
    GatherUnitFiles(BaseDir,SrcPath,SrcExt,false,true,FIDTTreeOfUnitFiles);
 
1389
    // add unitlinks
 
1390
    GatherUnitsFromSet;
 
1391
    // create list
 
1392
    CurSourceName:=GetSourceName;
 
1393
    ANode:=FIDTTreeOfUnitFiles.FindLowest;
 
1394
    while ANode<>nil do begin
 
1395
      UnitFileInfo:=TUnitFileInfo(ANode.Data);
 
1396
      if CompareIdentifiers(PChar(Pointer(UnitFileInfo.FileUnitName)),
 
1397
                            PChar(Pointer(CurSourceName)))<>0
 
1398
      then begin
 
1399
        NewItem:=TIdentifierListItem.Create(
 
1400
            icompCompatible,true,0,
 
1401
            CurrentIdentifierList.CreateIdentifier(UnitFileInfo.FileUnitName),
 
1402
            0,nil,nil,ctnUnit);
 
1403
        CurrentIdentifierList.Add(NewItem);
 
1404
      end;
 
1405
      ANode:=FIDTTreeOfUnitFiles.FindSuccessor(ANode);
 
1406
    end;
 
1407
  finally
 
1408
    FreeTreeOfUnitFiles(FIDTTreeOfUnitFiles);
 
1409
  end;
 
1410
end;
 
1411
 
 
1412
procedure TIdentCompletionTool.GatherSourceNames(const Context: TFindContext);
 
1413
 
 
1414
  procedure Add(const SrcName: string);
 
1415
  var
 
1416
    NewItem: TIdentifierListItem;
 
1417
  begin
 
1418
    NewItem:=TIdentifierListItem.Create(
 
1419
        icompExact,true,0,
 
1420
        CurrentIdentifierList.CreateIdentifier(SrcName),
 
1421
        0,nil,nil,Context.Node.Desc);
 
1422
    CurrentIdentifierList.Add(NewItem);
 
1423
  end;
 
1424
 
 
1425
var
 
1426
  NewSourceName: String;
 
1427
  FileSourceName: String;
 
1428
begin
 
1429
  // add the unitname as in the filename and as in the source
 
1430
  FileSourceName:=ExtractFilenameOnly(MainFilename);
 
1431
  NewSourceName:=GetSourceName(false);
 
1432
  //DebugLn('TIdentCompletionTool.GatherSourceNames FileSourceName=',FileSourceName,' NewSourceName=',NewSourceName);
 
1433
  if (FileSourceName<>lowercase(FileSourceName)) then begin
 
1434
    // the file is not written lowercase => case is important, ignore source name
 
1435
    Add(FileSourceName);
 
1436
  end else if (SysUtils.CompareText(NewSourceName,FileSourceName)<>0) then begin
 
1437
    // source name is not correct => only use file name
 
1438
    Add(FileSourceName);
 
1439
  end else if NewSourceName=FileSourceName then begin
 
1440
    // both are the same => add only one
 
1441
    Add(FileSourceName);
 
1442
  end else begin
 
1443
    // both are valid, just different in case
 
1444
    // the filename is written lowercase
 
1445
    // => prefer the source name
 
1446
    Add(NewSourceName);
 
1447
  end;
 
1448
end;
 
1449
 
 
1450
procedure TIdentCompletionTool.GatherContextKeywords(
 
1451
  const Context: TFindContext; CleanPos: integer;
 
1452
  BeautifyCodeOptions: TBeautifyCodeOptions);
 
1453
type
 
1454
  TPropertySpecifier = (
 
1455
    psIndex,psRead,psWrite,psStored,psImplements,psDefault,psNoDefault
 
1456
  );
 
1457
  TPropertySpecifiers = set of TPropertySpecifier;
 
1458
 
 
1459
  procedure Add(Keyword: string);
 
1460
  var
 
1461
    NewItem: TIdentifierListItem;
 
1462
  begin
 
1463
    KeyWord:=BeautifyCodeOptions.BeautifyKeyWord(Keyword);
 
1464
    NewItem:=TIdentifierListItem.Create(
 
1465
        icompExact,false,0,
 
1466
        CurrentIdentifierList.CreateIdentifier(Keyword),
 
1467
        1000,nil,nil,ctnNone);
 
1468
    include(NewItem.Flags,iliKeyword);
 
1469
    CurrentIdentifierList.Add(NewItem);
 
1470
  end;
 
1471
 
 
1472
  procedure AddSpecifiers(Forbidden: TPropertySpecifiers);
 
1473
  begin
 
1474
    if not (psIndex in Forbidden) then Add('index');
 
1475
    if not (psRead in Forbidden) then Add('read');
 
1476
    if not (psWrite in Forbidden) then Add('write');
 
1477
    if not (psStored in Forbidden) then Add('stored');
 
1478
    if not (psImplements in Forbidden) then Add('implements');
 
1479
    if not (psDefault in Forbidden) then Add('default');
 
1480
    if not (psNoDefault in Forbidden) then Add('nodefault');
 
1481
  end;
 
1482
 
 
1483
  procedure CheckProperty(PropNode: TCodeTreeNode);
 
1484
  var
 
1485
    Forbidden: TPropertySpecifiers;
 
1486
  begin
 
1487
    if not MoveCursorToPropType(PropNode) then exit;
 
1488
    if CleanPos<CurPos.EndPos then exit;
 
1489
    ReadNextAtom;
 
1490
    if CurPos.Flag=cafPoint then begin
 
1491
      ReadNextAtom;
 
1492
      if CurPos.Flag<>cafWord then exit;
 
1493
      ReadNextAtom;
 
1494
    end;
 
1495
    Forbidden:=[];
 
1496
    repeat
 
1497
      if CleanPos<=CurPos.EndPos then begin
 
1498
        AddSpecifiers(Forbidden);
 
1499
        exit;
 
1500
      end;
 
1501
      if (not (psIndex in Forbidden)) and UpAtomIs('INDEX') then begin
 
1502
        ReadNextAtom;
 
1503
        Include(Forbidden,psIndex);
 
1504
      end else if (not (psRead in Forbidden)) and UpAtomIs('READ') then begin
 
1505
        ReadNextAtom;
 
1506
        Forbidden:=Forbidden+[psIndex..psRead];
 
1507
      end else if (not (psWrite in Forbidden)) and UpAtomIs('WRITE') then begin
 
1508
        ReadNextAtom;
 
1509
        Forbidden:=Forbidden+[psIndex..psWrite];
 
1510
      end else if (not (psImplements in Forbidden)) and UpAtomIs('IMPLEMENTS')
 
1511
      then begin
 
1512
        ReadNextAtom;
 
1513
        exit;
 
1514
      end else if (not (psStored in Forbidden)) and UpAtomIs('STORED') then
 
1515
      begin
 
1516
        ReadNextAtom;
 
1517
        Forbidden:=Forbidden+[psIndex..psImplements];
 
1518
      end else if (not (psDefault in Forbidden)) and UpAtomIs('DEFAULT') then
 
1519
      begin
 
1520
        ReadNextAtom;
 
1521
        exit;
 
1522
      end else if (not (psNoDefault in Forbidden)) and UpAtomIs('NODEFAULT') then
 
1523
      begin
 
1524
        ReadNextAtom;
 
1525
        exit;
 
1526
      end else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
 
1527
        if not ReadTilBracketClose(false) then exit;
 
1528
      end else
 
1529
        ReadNextAtom;
 
1530
    until (CleanPos<CurPos.StartPos) or (CurPos.EndPos>SrcLen);
 
1531
  end;
 
1532
 
 
1533
  procedure AddMethodSpecifiers;
 
1534
  var
 
1535
    i: Integer;
 
1536
  begin
 
1537
    for i:=0 to IsKeyWordMethodSpecifier.Count-1 do
 
1538
      Add(IsKeyWordMethodSpecifier.GetItem(i).KeyWord+';');
 
1539
  end;
 
1540
 
 
1541
var
 
1542
  Node: TCodeTreeNode;
 
1543
  SubNode: TCodeTreeNode;
 
1544
  NodeInFront: TCodeTreeNode;
 
1545
  p: Integer;
 
1546
  NodeBehind: TCodeTreeNode;
 
1547
begin
 
1548
  Node:=Context.Node;
 
1549
  //debugln(['TIdentCompletionTool.GatherContextKeywords ',Node.DescAsString]);
 
1550
 
 
1551
  ReadPriorAtomSafe(CleanPos);
 
1552
  //debugln(['TIdentCompletionTool.GatherContextKeywords prioratom=',CleanPosToStr(CurPos.StartPos),'=',GetAtom(CurPos)]);
 
1553
  NodeInFront:=nil;
 
1554
  if CurPos.StartPos>0 then
 
1555
    NodeInFront:=FindDeepestNodeAtPos(CurPos.StartPos,false);
 
1556
 
 
1557
  NodeBehind:=nil;
 
1558
  MoveCursorToCleanPos(CleanPos);
 
1559
  ReadNextAtom;
 
1560
  //debugln(['TIdentCompletionTool.GatherContextKeywords nextatom=',CleanPosToStr(CurPos.StartPos),'=',GetAtom(CurPos)]);
 
1561
  if CurPos.StartPos>CleanPos then
 
1562
    NodeBehind:=FindDeepestNodeAtPos(CurPos.StartPos,false);
 
1563
 
 
1564
  //debugln(['TIdentCompletionTool.GatherContextKeywords Node=',Node.DescAsString,' NodeInFront=',NodeInFront.DescAsString,' NodeBehind=',NodeBehind.DescAsString]);
 
1565
 
 
1566
  case Node.Desc of
 
1567
  ctnClass,ctnObject,ctnRecordType,ctnObjCCategory,ctnObjCClass,
 
1568
  ctnClassPrivate,ctnClassProtected,ctnClassPublic,ctnClassPublished:
 
1569
    begin
 
1570
      Add('public');
 
1571
      Add('private');
 
1572
      Add('protected');
 
1573
      Add('published');
 
1574
      Add('procedure');
 
1575
      Add('function');
 
1576
      Add('property');
 
1577
      if (Node.Desc=ctnClass) or (Node.Parent.Desc=ctnClass) then begin
 
1578
        Add('constructor');
 
1579
        Add('destructor');
 
1580
      end;
 
1581
      if (Node.Desc=ctnRecordType) or (Node.Parent.Desc=ctnRecordType) then begin
 
1582
        Add('case');
 
1583
      end;
 
1584
      if (Node.LastChild<>nil) and (CleanPos>Node.LastChild.StartPos)
 
1585
      and (Node.LastChild.EndPos>Node.LastChild.StartPos)
 
1586
      and (Node.LastChild.EndPos<Srclen) then begin
 
1587
        //debugln(['TIdentCompletionTool.GatherContextKeywords end of class section ',dbgstr(copy(Src,Node.LastChild.EndPos-10,10))]);
 
1588
        SubNode:=Node.LastChild;
 
1589
        if SubNode.Desc=ctnProperty then begin
 
1590
          CheckProperty(SubNode);
 
1591
        end;
 
1592
      end;
 
1593
      if NodeInFront<>nil then begin
 
1594
        if NodeInFront.Desc=ctnProcedure then
 
1595
          AddMethodSpecifiers;
 
1596
      end;
 
1597
    end;
 
1598
 
 
1599
  ctnClassInterface,ctnDispinterface,ctnObjCProtocol,ctnCPPClass:
 
1600
    begin
 
1601
      Add('procedure');
 
1602
      Add('function');
 
1603
    end;
 
1604
 
 
1605
  ctnInterface,ctnImplementation:
 
1606
    begin
 
1607
      if (Node.FirstChild=nil)
 
1608
      or ((Node.FirstChild.Desc<>ctnUsesSection)
 
1609
        and (Node.FirstChild.StartPos>=CleanPos))
 
1610
      then
 
1611
        Add('uses');
 
1612
      Add('type');
 
1613
      Add('var');
 
1614
      Add('const');
 
1615
      Add('procedure');
 
1616
      Add('function');
 
1617
      Add('resourcestring');
 
1618
      if Node.Desc=ctnInterface then begin
 
1619
        Add('property');
 
1620
      end;
 
1621
      if (NodeBehind=nil)
 
1622
      or (NodeBehind.Desc in [ctnInitialization,ctnFinalization,ctnEndPoint,ctnBeginBlock])
 
1623
      then begin
 
1624
        if Node.Desc=ctnInterface then
 
1625
          Add('implementation');
 
1626
        Add('initialization');
 
1627
        Add('finalization');
 
1628
      end;
 
1629
    end;
 
1630
 
 
1631
  ctnInitialization:
 
1632
    if (NodeBehind=nil)
 
1633
    or (NodeBehind.Desc in [ctnInitialization,ctnFinalization,ctnEndPoint,ctnBeginBlock])
 
1634
    then begin
 
1635
      Add('finalization');
 
1636
      Add('begin');
 
1637
    end;
 
1638
 
 
1639
  ctnProcedure:
 
1640
    begin
 
1641
      Add('begin');
 
1642
      Add('type');
 
1643
      Add('var');
 
1644
      Add('const');
 
1645
      Add('procedure');
 
1646
      Add('function');
 
1647
    end;
 
1648
 
 
1649
  ctnProcedureHead:
 
1650
    begin
 
1651
      MoveCursorBehindProcName(Node);
 
1652
      p:=CurPos.StartPos;
 
1653
      while (p>=1) and (Src[p] in [' ',#9]) do dec(p);
 
1654
      if CleanPos>=p then
 
1655
        AddMethodSpecifiers;
 
1656
    end;
 
1657
 
 
1658
  ctnVarDefinition:
 
1659
    if Node.Parent.Desc in [ctnClass,ctnObject,ctnRecordType,ctnObjCCategory,ctnObjCClass]
 
1660
      +AllClassBaseSections
 
1661
    then begin
 
1662
      Add('public');
 
1663
      Add('private');
 
1664
      Add('protected');
 
1665
      Add('published');
 
1666
      Add('procedure');
 
1667
      Add('function');
 
1668
      Add('property');
 
1669
      if [cmsObjectiveC1,cmsObjectiveC2]*Scanner.CompilerModeSwitches<>[] then
 
1670
      begin
 
1671
        Add('required');
 
1672
        Add('optional');
 
1673
      end;
 
1674
      if (Node.Desc=ctnClass) or (Node.Parent.Desc=ctnClass) then begin
 
1675
        Add('constructor');
 
1676
        Add('destructor');
 
1677
      end;
 
1678
      if (Node.Desc=ctnRecordType) or (Node.Parent.Desc=ctnRecordType) then begin
 
1679
        Add('case');
 
1680
      end;
 
1681
    end;
 
1682
 
 
1683
  ctnTypeSection,ctnVarSection,ctnConstSection,ctnLabelSection,ctnResStrSection,
 
1684
  ctnLibrary,ctnProgram:
 
1685
    begin
 
1686
      Add('type');
 
1687
      Add('const');
 
1688
      Add('var');
 
1689
      Add('resourcestring');
 
1690
      Add('procedure');
 
1691
      Add('function');
 
1692
      Add('property');
 
1693
      if Node.Desc=ctnLibrary then begin
 
1694
        Add('initialization');
 
1695
        Add('finalization');
 
1696
        Add('begin');
 
1697
      end;
 
1698
    end;
 
1699
 
 
1700
  ctnProperty:
 
1701
    CheckProperty(Node);
 
1702
 
 
1703
  end;
 
1704
end;
 
1705
 
 
1706
procedure TIdentCompletionTool.InitCollectIdentifiers(
 
1707
  const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList);
 
1708
var
 
1709
  StartContext: TFindContext;
 
1710
begin
 
1711
  if IdentifierList=nil then IdentifierList:=TIdentifierList.Create;
 
1712
  CurrentIdentifierList:=IdentifierList;
 
1713
  CurrentIdentifierList.Clear;
 
1714
  FLastGatheredIdentParent:=nil;
 
1715
  FLastGatheredIdentLevel:=0;
 
1716
  CurrentIdentifierList.StartContextPos:=CursorPos;
 
1717
  StartContext := CurrentIdentifierList.StartContext;
 
1718
  StartContext.Tool := Self;
 
1719
  CurrentIdentifierList.StartContext:=StartContext;
 
1720
end;
 
1721
 
 
1722
procedure TIdentCompletionTool.ParseSourceTillCollectionStart(
 
1723
  const CursorPos: TCodeXYPosition; out CleanCursorPos: integer;
 
1724
  out CursorNode: TCodeTreeNode; out IdentStartPos, IdentEndPos: integer);
 
1725
var
 
1726
  StartContext: TFindContext;
 
1727
  ContextPos: Integer;
 
1728
begin
 
1729
  CleanCursorPos:=0;
 
1730
  CursorNode:=nil;
 
1731
  IdentStartPos:=0;
 
1732
  IdentEndPos:=0;
 
1733
 
 
1734
  // build code tree
 
1735
  {$IFDEF CTDEBUG}
 
1736
  DebugLn(['TIdentCompletionTool.ParseSourceTillCollectionStart A CursorPos=',dbgs(CursorPos)]);
 
1737
  {$ENDIF}
 
1738
  BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
 
1739
                          [btSetIgnoreErrorPos]);
 
1740
 
 
1741
  // find node at position
 
1742
  ContextPos:=CleanCursorPos;
 
1743
  // The context node might be in front of the CleanCursorPos
 
1744
  // For example: A.|end; In this case the statement ends at the point.
 
1745
  // Check the atom in front
 
1746
  ReadPriorAtomSafe(CleanCursorPos);
 
1747
  if (CurPos.Flag<>cafNone) then begin
 
1748
    ContextPos:=CurPos.EndPos;
 
1749
    if (CurPos.Flag in [cafPoint,cafRoundBracketOpen,cafEdgedBracketOpen])
 
1750
    or UpAtomIs('INHERITED') then
 
1751
      ContextPos:=CurPos.StartPos;
 
1752
  end;
 
1753
 
 
1754
  CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(ContextPos,true);
 
1755
  if CurrentIdentifierList<>nil then begin
 
1756
    StartContext:=CurrentIdentifierList.StartContext;
 
1757
    StartContext.Node:=CursorNode;
 
1758
    CurrentIdentifierList.StartContext:=StartContext;
 
1759
  end;
 
1760
  
 
1761
  // get identifier position
 
1762
  GetIdentStartEndAtPosition(Src,CleanCursorPos,IdentStartPos,IdentEndPos);
 
1763
  //DebugLn(['TIdentCompletionTool.ParseSourceTillCollectionStart ',dbgstr(copy(Src,IdentStartPos,10)),' CursorPos.X=',CursorPos.X,' LineLen=',CursorPos.Code.GetLineLength(CursorPos.Y-1),' ',CursorPos.Code.getline(CursorPos.Y-1)]);
 
1764
  if CursorPos.X>CursorPos.Code.GetLineLength(CursorPos.Y-1)+1 then
 
1765
    IdentStartPos:=IdentEndPos;
 
1766
end;
 
1767
 
 
1768
function TIdentCompletionTool.FindIdentifierStartPos(
 
1769
  const CursorPos: TCodeXYPosition): TCodeXYPosition;
 
1770
var
 
1771
  p: integer;
 
1772
  IdentStartPos, IdentEndPos: integer;
 
1773
begin
 
1774
  CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,p);
 
1775
  if p<1 then
 
1776
    RaiseException(ctsCursorPosOutsideOfCode);
 
1777
  if CursorPos.X<=CursorPos.Code.GetLineLength(CursorPos.Y-1)+1 then begin
 
1778
    GetIdentStartEndAtPosition(CursorPos.Code.Source,p,IdentStartPos,IdentEndPos);
 
1779
  end else begin
 
1780
    IdentStartPos:=p;
 
1781
    IdentEndPos:=p;
 
1782
  end;
 
1783
  Result:=CursorPos;
 
1784
  if IdentStartPos>0 then
 
1785
    dec(Result.X,p-IdentStartPos);
 
1786
  //DebugLn(['TIdentCompletionTool.FindIdentifierStartPos ',dbgstr(copy(CursorPos.Code.Source,IdentStartPos,20))]);
 
1787
end;
 
1788
 
 
1789
procedure TIdentCompletionTool.FindCollectionContext(
 
1790
  Params: TFindDeclarationParams; IdentStartPos: integer;
 
1791
  CursorNode: TCodeTreeNode;
 
1792
  out GatherContext: TFindContext;
 
1793
  out ContextExprStartPos: LongInt;
 
1794
  out StartInSubContext: Boolean);
 
1795
 
 
1796
  function GetContextExprStartPos(IdentStartPos: integer;
 
1797
    ContextNode: TCodeTreeNode): integer;
 
1798
  begin
 
1799
    MoveCursorToCleanPos(IdentStartPos);
 
1800
    ReadPriorAtom;
 
1801
    if (CurPos.Flag=cafPoint)
 
1802
    or UpAtomIs('INHERITED') then begin
 
1803
      Result:=FindStartOfTerm(IdentStartPos,NodeTermInType(ContextNode));
 
1804
      if Result<ContextNode.StartPos then
 
1805
        Result:=ContextNode.StartPos;
 
1806
    end else
 
1807
      Result:=IdentStartPos;
 
1808
    MoveCursorToCleanPos(Result);
 
1809
    ReadNextAtom;
 
1810
    case ContextNode.Desc of
 
1811
    ctnProperty:
 
1812
      // check for special property keywords
 
1813
      if WordIsPropertySpecifier.DoItCaseInsensitive(Src,
 
1814
          CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
 
1815
      then
 
1816
        // do not resolve property specifiers
 
1817
        Result:=IdentStartPos;
 
1818
    end;
 
1819
  end;
 
1820
 
 
1821
var
 
1822
  ExprType: TExpressionType;
 
1823
  IgnoreCurContext: Boolean;
 
1824
begin
 
1825
  GatherContext:=CreateFindContext(Self,CursorNode);
 
1826
 
 
1827
  IgnoreCurContext:=false;
 
1828
  //DebugLn(['TIdentCompletionTool.FindCollectionContext IdentStartPos=',dbgstr(copy(Src,IdentStartPos,20)),' ',CursorNode.DescAsString]);
 
1829
  ContextExprStartPos:=GetContextExprStartPos(IdentStartPos,CursorNode);
 
1830
  if GatherContext.Node.Desc=ctnWithVariable then begin
 
1831
    if GatherContext.Node.PriorBrother<>nil then
 
1832
      GatherContext.Node:=GatherContext.Node.PriorBrother
 
1833
    else
 
1834
      GatherContext.Node:=GatherContext.Node.Parent;
 
1835
  end
 
1836
  else if (GatherContext.Node.GetNodeOfType(ctnClassInheritance)<>nil) then
 
1837
  begin
 
1838
    while not (GatherContext.Node.Desc in AllClasses) do
 
1839
      GatherContext.Node:=GatherContext.Node.Parent;
 
1840
    GatherContext.Node:=GatherContext.Node.Parent;
 
1841
    IgnoreCurContext:=true;
 
1842
  end else if GatherContext.Node.Desc=ctnIdentifier then begin
 
1843
    IgnoreCurContext:=true;
 
1844
  end;
 
1845
 
 
1846
  StartInSubContext:=false;
 
1847
  //DebugLn(['TIdentCompletionTool.FindCollectionContext ContextExprStartPos=',ContextExprStartPos,' "',dbgstr(copy(Src,ContextExprStartPos,20)),'" IdentStartPos="',dbgstr(copy(Src,IdentStartPos,20)),'" Gather=',FindContextToString(GatherContext)]);
 
1848
  if ContextExprStartPos<IdentStartPos then begin
 
1849
    MoveCursorToCleanPos(IdentStartPos);
 
1850
    Params.ContextNode:=CursorNode;
 
1851
    Params.SetIdentifier(Self,nil,nil);
 
1852
    Params.Flags:=[fdfExceptionOnNotFound,
 
1853
                   fdfSearchInParentNodes,fdfSearchInAncestors];
 
1854
    if IgnoreCurContext then
 
1855
      Params.Flags:=Params.Flags+[fdfIgnoreCurContextNode];
 
1856
    ExprType:=FindExpressionTypeOfTerm(ContextExprStartPos,IdentStartPos,
 
1857
                                       Params,false);
 
1858
    if (ExprType.Desc=xtContext) then begin
 
1859
      GatherContext:=ExprType.Context;
 
1860
      StartInSubContext:=true;
 
1861
    end;
 
1862
  end;
 
1863
end;
 
1864
 
 
1865
function TIdentCompletionTool.CollectAllContexts(
 
1866
  Params: TFindDeclarationParams; const FoundContext: TFindContext
 
1867
  ): TIdentifierFoundResult;
 
1868
begin
 
1869
  Result:=ifrProceedSearch;
 
1870
  if FoundContext.Node=nil then exit;
 
1871
  //DebugLn(['TIdentCompletionTool.CollectAllContexts ',FoundContext.Node.DescAsString]);
 
1872
  case FoundContext.Node.Desc of
 
1873
  ctnProcedure:
 
1874
    begin
 
1875
      //DebugLn('TIdentCompletionTool.CollectAllContexts CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentIdentifierContexts.ProcNameAtom.StartPos));
 
1876
      if (CurrentIdentifierContexts.ProcName='') then exit;
 
1877
      FoundContext.Tool.MoveCursorToProcName(FoundContext.Node,true);
 
1878
      //DebugLn(['TIdentCompletionTool.CollectAllContexts ProcName=',GetIdentifier(@FoundContext.Tool.Src[FoundContext.Tool.CurPos.StartPos])]);
 
1879
      if not FoundContext.Tool.CompareSrcIdentifiers(
 
1880
        FoundContext.Tool.CurPos.StartPos,
 
1881
        PChar(CurrentIdentifierContexts.ProcName))
 
1882
      then exit;
 
1883
    end;
 
1884
  ctnProperty:
 
1885
    begin
 
1886
      if (CurrentIdentifierContexts.ProcName='') then exit;
 
1887
      FoundContext.Tool.MoveCursorToPropName(FoundContext.Node);
 
1888
      if not FoundContext.Tool.CompareSrcIdentifiers(
 
1889
        FoundContext.Tool.CurPos.StartPos,
 
1890
        PChar(CurrentIdentifierContexts.ProcName))
 
1891
      then exit;
 
1892
    end;
 
1893
  ctnVarDefinition:
 
1894
    begin
 
1895
      if (CurrentIdentifierContexts.ProcName='') then exit;
 
1896
      if not FoundContext.Tool.CompareSrcIdentifiers(
 
1897
        FoundContext.Node.StartPos,
 
1898
        PChar(CurrentIdentifierContexts.ProcName))
 
1899
      then exit;
 
1900
    end;
 
1901
  else
 
1902
    exit;
 
1903
  end;
 
1904
  //DebugLn(['TIdentCompletionTool.CollectAllContexts add ',FoundContext.Node.DescAsString]);
 
1905
  AddCollectionContext(FoundContext.Tool,FoundContext.Node);
 
1906
end;
 
1907
 
 
1908
procedure TIdentCompletionTool.AddCollectionContext(Tool: TFindDeclarationTool;
 
1909
  Node: TCodeTreeNode);
 
1910
begin
 
1911
  if CurrentIdentifierContexts=nil then
 
1912
    CurrentIdentifierContexts:=TCodeContextInfo.Create;
 
1913
  CurrentIdentifierContexts.Add(CreateExpressionType(xtContext,xtNone,
 
1914
                                           CreateFindContext(Tool,Node)));
 
1915
  //DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[]));
 
1916
end;
 
1917
 
 
1918
procedure TIdentCompletionTool.InitFoundMethods;
 
1919
begin
 
1920
  if FIDTFoundMethods<>nil then ClearFoundMethods;
 
1921
  FIDTFoundMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
 
1922
end;
 
1923
 
 
1924
procedure TIdentCompletionTool.ClearFoundMethods;
 
1925
begin
 
1926
  if FIDTFoundMethods=nil then exit;
 
1927
  FreeAndNil(FIDTFoundMethods);
 
1928
end;
 
1929
 
 
1930
function TIdentCompletionTool.CollectMethods(
 
1931
  Params: TFindDeclarationParams; const FoundContext: TFindContext
 
1932
  ): TIdentifierFoundResult;
 
1933
var
 
1934
  ProcText: String;
 
1935
  AVLNode: TAVLTreeNode;
 
1936
  NodeExt: TCodeTreeNodeExtension;
 
1937
begin
 
1938
  // proceed searching ...
 
1939
  Result:=ifrProceedSearch;
 
1940
 
 
1941
  {$IFDEF ShowFoundIdents}
 
1942
  //if FoundContext.Tool=Self then
 
1943
  DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
 
1944
    ' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"');
 
1945
  {$ENDIF}
 
1946
  
 
1947
  if FoundContext.Node.Desc=ctnProcedure then begin
 
1948
    ProcText:=FoundContext.Tool.ExtractProcHead(FoundContext.Node,
 
1949
                              [phpWithoutClassKeyword,phpWithHasDefaultValues]);
 
1950
    AVLNode:=FindCodeTreeNodeExtAVLNode(FIDTFoundMethods,ProcText);
 
1951
    if AVLNode<>nil then begin
 
1952
      // method is overriden => ignore
 
1953
    end else begin
 
1954
      // new method
 
1955
      NodeExt:=TCodeTreeNodeExtension.Create;
 
1956
      NodeExt.Node:=FoundContext.Node;
 
1957
      NodeExt.Data:=FoundContext.Tool;
 
1958
      NodeExt.Txt:=ProcText;
 
1959
      FIDTFoundMethods.Add(NodeExt);
 
1960
    end;
 
1961
  end;
 
1962
end;
 
1963
 
 
1964
function TIdentCompletionTool.IsInCompilerDirective(CursorPos: TCodeXYPosition
 
1965
  ): boolean;
 
1966
 
 
1967
  procedure Key(const DirectiveName: string);
 
1968
  var
 
1969
    NewItem: TIdentifierListItem;
 
1970
  begin
 
1971
    NewItem:=TIdentifierListItem.Create(
 
1972
        icompExact,false,0,
 
1973
        CurrentIdentifierList.CreateIdentifier(DirectiveName),
 
1974
        1000,nil,nil,ctnNone);
 
1975
    include(NewItem.Flags,iliKeyword);
 
1976
    CurrentIdentifierList.Add(NewItem);
 
1977
  end;
 
1978
 
 
1979
  procedure AddMacros;
 
1980
  var
 
1981
    Macros: TStringToStringTree;
 
1982
    StrItem: PStringToStringTreeItem;
 
1983
 
 
1984
    procedure Add(e: TExpressionEvaluator);
 
1985
    var
 
1986
      i: Integer;
 
1987
    begin
 
1988
      for i:=0 to e.Count-1 do
 
1989
        Macros[e.Names(i)]:=e.Values(i);
 
1990
    end;
 
1991
 
 
1992
  begin
 
1993
    Macros:=TStringToStringTree.Create(false);
 
1994
    try
 
1995
      Add(Scanner.InitialValues);
 
1996
      Add(Scanner.Values);
 
1997
      for StrItem in Macros do
 
1998
        Key(StrItem^.Name);
 
1999
    finally
 
2000
      Macros.Free;
 
2001
    end;
 
2002
  end;
 
2003
 
 
2004
var
 
2005
  Line: String;
 
2006
  p: Integer;
 
2007
  EndPos: Integer;
 
2008
  InnerStart: Integer;
 
2009
  Directive: String;
 
2010
  ms: TCompilerModeSwitch;
 
2011
begin
 
2012
  Result:=false;
 
2013
  Line:=CursorPos.Code.GetLine(CursorPos.Y-1);
 
2014
  p:=1;
 
2015
  while p<=length(Line) do begin
 
2016
    p:=FindNextCompilerDirective(Line,p,Scanner.NestedComments);
 
2017
    if p>length(Line) then exit;
 
2018
    EndPos:=FindCommentEnd(Line,p,Scanner.NestedComments);
 
2019
    if (CursorPos.X>p) and (CursorPos.X<EndPos) then begin
 
2020
      // in a directive
 
2021
      Result:=true;
 
2022
      InnerStart:=p;
 
2023
      if Line[InnerStart]='{' then
 
2024
        inc(InnerStart,2)
 
2025
      else
 
2026
        inc(InnerStart,3);
 
2027
      //debugln(['TIdentCompletionTool.IsInCompilerDirective InnerStart=',InnerStart,' X=',CursorPos.X]);
 
2028
      if (InnerStart=CursorPos.X)
 
2029
      or ((CursorPos.X>=InnerStart) and (InnerStart<=length(Line))
 
2030
          and (CursorPos.X<=InnerStart+GetIdentLen(@Line[InnerStart])))
 
2031
      then begin
 
2032
        Key('ALIGN');
 
2033
        Key('ALIGNASSERTIONS');
 
2034
        Key('ASMMODE');
 
2035
        Key('ASSERTIONS');
 
2036
        Key('BITPACKING');
 
2037
        Key('BOOLEVAL');
 
2038
        Key('CALLING');
 
2039
        Key('CHECKPOINTER');
 
2040
        Key('CODEALIGN');
 
2041
        Key('COPERATORS');
 
2042
        Key('DEBUGINFO');
 
2043
        Key('DEFINE');
 
2044
        Key('ELIFC');
 
2045
        Key('ELSE');
 
2046
        Key('ELSEC');
 
2047
        Key('ELSEIF');
 
2048
        Key('ENDC');
 
2049
        Key('ENDIF');
 
2050
        Key('ERROR');
 
2051
        Key('ERRORC');
 
2052
        Key('EXTENDEDSYNTAX');
 
2053
        Key('FATAL');
 
2054
        Key('FPUTYPE');
 
2055
        Key('GOTO');
 
2056
        Key('HINT');
 
2057
        Key('HINTS');
 
2058
        Key('IFC');
 
2059
        Key('IFDEF');
 
2060
        Key('IFEND');
 
2061
        Key('IFNDEF');
 
2062
        Key('IFOPT');
 
2063
        Key('IMPLICITEXCEPTIONS');
 
2064
        Key('INCLUDE');
 
2065
        Key('INCLUDEPATH');
 
2066
        Key('INFO');
 
2067
        Key('INLINE');
 
2068
        Key('INTERFACES');
 
2069
        Key('IOCHECKS');
 
2070
        Key('LINK');
 
2071
        Key('LINKFRAMEWORK');
 
2072
        Key('LINKLIB');
 
2073
        Key('LOCALSYMBOLS');
 
2074
        Key('LONGSTRINGS');
 
2075
        Key('MACRO');
 
2076
        Key('MAXFPUREGISTERS');
 
2077
        Key('MESSAGE');
 
2078
        Key('MINENUMSIZE');
 
2079
        Key('MMX');
 
2080
        Key('MODE');
 
2081
        Key('MODESWITCH');
 
2082
        Key('NAMESPACE');
 
2083
        Key('NOTE');
 
2084
        Key('NOTES');
 
2085
        Key('OBJECTCHECKS');
 
2086
        Key('OPENSTRINGS');
 
2087
        Key('OPTIMIZATION');
 
2088
        Key('OUTPUT_FORMAT');
 
2089
        Key('OV');
 
2090
        Key('OVERFLOWCHECKS');
 
2091
        Key('PACKENUM');
 
2092
        Key('PACKRECORDS');
 
2093
        Key('PACKSET');
 
2094
        Key('POINTERMATH');
 
2095
        Key('POP');
 
2096
        Key('PUSH');
 
2097
        Key('RANGECHECKS');
 
2098
        Key('REFERENCEINFO');
 
2099
        Key('SETC');
 
2100
        Key('STACKFRAMES');
 
2101
        Key('STOP');
 
2102
        Key('THREADING');
 
2103
        Key('TYPEADDRESS');
 
2104
        Key('TYPEINFO');
 
2105
        Key('UNDEF');
 
2106
        Key('VARSTRINGCHECKS');
 
2107
        Key('WAIT');
 
2108
        Key('WARNING');
 
2109
        Key('WARNINGS');
 
2110
        Key('WRITABLECONST');
 
2111
      end else if InnerStart<=length(Line) then begin
 
2112
        Directive:=lowercase(GetIdentifier(@Line[InnerStart]));
 
2113
        if (Directive='ifdef')
 
2114
        or (Directive='ifndef')
 
2115
        or (Directive='if')
 
2116
        or (Directive='elseif')
 
2117
        or (Directive='ifc')
 
2118
        then begin
 
2119
          AddMacros;
 
2120
        end else if Directive='modeswitch' then begin
 
2121
          for ms:=low(TCompilerModeSwitch) to high(TCompilerModeSwitch) do
 
2122
            Key(lowercase(CompilerModeSwitchNames[ms]));
 
2123
        end;
 
2124
      end;
 
2125
      exit;
 
2126
    end;
 
2127
    p:=EndPos;
 
2128
  end;
 
2129
end;
 
2130
 
 
2131
function TIdentCompletionTool.GatherAvailableUnitNames(const CursorPos: TCodeXYPosition;
 
2132
  var IdentifierList: TIdentifierList): Boolean;
 
2133
begin
 
2134
  Result:=false;
 
2135
 
 
2136
  try
 
2137
    InitCollectIdentifiers(CursorPos, IdentifierList);
 
2138
 
 
2139
    GatherUnitNames;
 
2140
    Result:=true;
 
2141
 
 
2142
  finally
 
2143
    CurrentIdentifierList:=nil;
 
2144
  end;
 
2145
end;
 
2146
 
 
2147
function TIdentCompletionTool.GatherIdentifiers(
 
2148
  const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList;
 
2149
  BeautifyCodeOptions: TBeautifyCodeOptions): boolean;
 
2150
var
 
2151
  CleanCursorPos, IdentStartPos, IdentEndPos: integer;
 
2152
  CursorNode: TCodeTreeNode;
 
2153
  Params: TFindDeclarationParams;
 
2154
  GatherContext: TFindContext;
 
2155
  ContextExprStartPos: Integer;
 
2156
  StartInSubContext: Boolean;
 
2157
  StartPosOfVariable: LongInt;
 
2158
  CursorContext: TFindContext;
 
2159
  IdentStartXY: TCodeXYPosition;
 
2160
  InFrontOfDirective: Boolean;
 
2161
  
 
2162
  procedure CheckProcedureDeclarationContext;
 
2163
  var
 
2164
    Node: TCodeTreeNode;
 
2165
    Can: Boolean;
 
2166
  begin
 
2167
    //DebugLn(['CheckProcedureDeclarationContext ',CursorNode.DescAsString]);
 
2168
    Node:=CursorNode;
 
2169
    Can:=false;
 
2170
    if (Node.Parent<>nil)
 
2171
    and (Node.Parent.Desc in AllClassSections)
 
2172
    and (Node.Desc=ctnVarDefinition)
 
2173
    and (CurrentIdentifierList.StartAtomBehind.Flag<>cafColon) then begin
 
2174
      { cursor is at a class variable definition without type
 
2175
        for example:
 
2176
        
 
2177
        public
 
2178
          MouseM|
 
2179
        end;
 
2180
      }
 
2181
      Can:=true;
 
2182
    end
 
2183
    else if (((Node.Desc=ctnProcedure) and (not NodeIsMethodBody(Node)))
 
2184
    or ((Node.Desc=ctnProcedureHead) and (not NodeIsMethodBody(Node.Parent))))
 
2185
    and (not (CurrentIdentifierList.StartAtomBehind.Flag
 
2186
              in [cafEdgedBracketOpen,cafRoundBracketOpen]))
 
2187
    then begin
 
2188
      // for example: procedure DoSomething|
 
2189
      Can:=true;
 
2190
    end
 
2191
    else if Node.Desc in (AllClassBaseSections+AllSourceTypes
 
2192
                     +[ctnInterface,ctnImplementation])
 
2193
    then begin
 
2194
      //DebugLn(['TIdentCompletionTool.CheckProcedureDeclarationContext ilcfCanProcDeclaration']);
 
2195
      Can:=true;
 
2196
    end;
 
2197
    if Can then
 
2198
      CurrentIdentifierList.ContextFlags:=
 
2199
        CurrentIdentifierList.ContextFlags+[ilcfCanProcDeclaration];
 
2200
  end;
 
2201
 
 
2202
begin
 
2203
  Result:=false;
 
2204
 
 
2205
  ActivateGlobalWriteLock;
 
2206
  Params:=TFindDeclarationParams.Create;
 
2207
  try
 
2208
    InitCollectIdentifiers(CursorPos,IdentifierList);
 
2209
    IdentStartXY:=FindIdentifierStartPos(CursorPos);
 
2210
    if IsInCompilerDirective(IdentStartXY) then exit(true);
 
2211
 
 
2212
    ParseSourceTillCollectionStart(IdentStartXY,CleanCursorPos,CursorNode,
 
2213
                                   IdentStartPos,IdentEndPos);
 
2214
    if CleanCursorPos=0 then ;
 
2215
    if IdentStartPos>0 then begin
 
2216
      MoveCursorToCleanPos(IdentStartPos);
 
2217
      ReadNextAtom;
 
2218
      CurrentIdentifierList.StartAtom:=CurPos;
 
2219
    end;
 
2220
 
 
2221
    // find context
 
2222
    {$IFDEF CTDEBUG}
 
2223
    DebugLn('TIdentCompletionTool.GatherIdentifiers B',
 
2224
      ' CleanCursorPos=',dbgs(CleanCursorPos),
 
2225
      ' IdentStartPos=',dbgs(IdentStartPos),' IdentEndPos=',dbgs(IdentEndPos),
 
2226
      ' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos));
 
2227
    {$ENDIF}
 
2228
    GatherContext:=CreateFindContext(Self,CursorNode);
 
2229
    CurrentIdentifierList.NewMemberVisibility:=GetClassVisibility(CursorNode);
 
2230
    if CursorNode.Desc in [ctnUsesSection,ctnUseUnit] then begin
 
2231
      GatherUnitNames;
 
2232
      MoveCursorToCleanPos(IdentEndPos);
 
2233
      ReadNextAtom;
 
2234
      if (CurPos.Flag=cafWord) and (not UpAtomIs('IN')) then begin
 
2235
        // add comma
 
2236
        CurrentIdentifierList.ContextFlags:=
 
2237
          CurrentIdentifierList.ContextFlags+[ilcfNeedsEndComma];
 
2238
      end;
 
2239
    end else if (CursorNode.Desc in AllSourceTypes)
 
2240
    and (PositionsInSameLine(Src,CursorNode.StartPos,IdentStartPos)) then begin
 
2241
      GatherSourceNames(GatherContext);
 
2242
    end else begin
 
2243
      FindCollectionContext(Params,IdentStartPos,CursorNode,
 
2244
                           GatherContext,ContextExprStartPos,StartInSubContext);
 
2245
 
 
2246
      // find class and ancestors if existing (needed for protected identifiers)
 
2247
      if GatherContext.Tool = Self then
 
2248
        FindContextClassAndAncestors(IdentStartXY, FICTClassAndAncestors);
 
2249
 
 
2250
      CursorContext:=CreateFindContext(Self,CursorNode);
 
2251
      GatherContextKeywords(CursorContext,IdentStartPos,BeautifyCodeOptions);
 
2252
 
 
2253
      // search and gather identifiers in context
 
2254
      if (GatherContext.Tool<>nil) and (GatherContext.Node<>nil) then begin
 
2255
        {$IFDEF CTDEBUG}
 
2256
        DebugLn('TIdentCompletionTool.GatherIdentifiers D CONTEXT: ',
 
2257
          GatherContext.Tool.MainFilename,
 
2258
          ' ',GatherContext.Node.DescAsString,
 
2259
          ' "',StringToPascalConst(copy(GatherContext.Tool.Src,GatherContext.Node.StartPos,50)),'"');
 
2260
        {$ENDIF}
 
2261
 
 
2262
        // gather all identifiers in context
 
2263
        Params.ContextNode:=GatherContext.Node;
 
2264
        Params.SetIdentifier(Self,nil,@CollectAllIdentifiers);
 
2265
        Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
 
2266
        if (Params.ContextNode.Desc=ctnInterface) and StartInSubContext then
 
2267
          Include(Params.Flags,fdfIgnoreUsedUnits);
 
2268
        if not StartInSubContext then
 
2269
          Include(Params.Flags,fdfSearchInParentNodes);
 
2270
        if Params.ContextNode.Desc in AllClasses then
 
2271
          Exclude(Params.Flags,fdfSearchInParentNodes);
 
2272
        {$IFDEF CTDEBUG}
 
2273
        DebugLn('TIdentCompletionTool.GatherIdentifiers F');
 
2274
        {$ENDIF}
 
2275
        CurrentIdentifierList.Context:=GatherContext;
 
2276
        if GatherContext.Node.Desc=ctnIdentifier then
 
2277
          Params.Flags:=Params.Flags+[fdfIgnoreCurContextNode];
 
2278
        GatherContext.Tool.FindIdentifierInContext(Params);
 
2279
      end;
 
2280
 
 
2281
      // check for incomplete context
 
2282
      
 
2283
      // context bracket level
 
2284
      CurrentIdentifierList.StartBracketLvl:=
 
2285
        GetBracketLvl(Src,CursorNode.StartPos,IdentStartPos,
 
2286
                      Scanner.NestedComments);
 
2287
      if CursorNode.Desc in AllPascalStatements then begin
 
2288
        CurrentIdentifierList.ContextFlags:=
 
2289
          CurrentIdentifierList.ContextFlags+[ilcfStartInStatement];
 
2290
      end;
 
2291
 
 
2292
      // context in front of
 
2293
      StartPosOfVariable:=FindStartOfTerm(IdentStartPos,NodeTermInType(CursorNode));
 
2294
      if StartPosOfVariable>0 then begin
 
2295
        if StartPosOfVariable=IdentStartPos then begin
 
2296
          // cursor is at start of an operand
 
2297
          CurrentIdentifierList.ContextFlags:=
 
2298
            CurrentIdentifierList.ContextFlags+[ilcfStartOfOperand];
 
2299
        end else begin
 
2300
          MoveCursorToCleanPos(IdentStartPos);
 
2301
          ReadPriorAtom;
 
2302
          if CurPos.Flag=cafPoint then
 
2303
            // cursor is behind a point
 
2304
            CurrentIdentifierList.ContextFlags:=
 
2305
              CurrentIdentifierList.ContextFlags+[ilcfStartIsSubIdent];
 
2306
        end;
 
2307
        MoveCursorToCleanPos(StartPosOfVariable);
 
2308
        ReadPriorAtom;
 
2309
        CurrentIdentifierList.StartAtomInFront:=CurPos;
 
2310
        if (ilcfStartInStatement in CurrentIdentifierList.ContextFlags)
 
2311
        and (not IsDirtySrcValid) then
 
2312
        begin
 
2313
          // check if LValue
 
2314
          if (CurPos.Flag in [cafSemicolon,cafEnd,cafColon])
 
2315
          or UpAtomIs('BEGIN')
 
2316
          or UpAtomIs('TRY') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
 
2317
          or UpAtomIs('FOR') or UpAtomIs('DO') or UpAtomIs('THEN')
 
2318
          or UpAtomIs('REPEAT') or UpAtomIs('ASM') or UpAtomIs('ELSE')
 
2319
          then begin
 
2320
            CurrentIdentifierList.ContextFlags:=
 
2321
              CurrentIdentifierList.ContextFlags+[ilcfStartOfStatement];
 
2322
          end;
 
2323
          // check if expression
 
2324
          if UpAtomIs('IF') or UpAtomIs('CASE') or UpAtomIs('WHILE')
 
2325
          or UpAtomIs('UNTIL')
 
2326
          then begin
 
2327
            // todo: check at start of expression, not only in front of variable
 
2328
            CurrentIdentifierList.ContextFlags:=
 
2329
              CurrentIdentifierList.ContextFlags+[ilcfIsExpression];
 
2330
          end;
 
2331
        end;
 
2332
      end;
 
2333
      // context behind
 
2334
      if (IdentEndPos<SrcLen) and (not IsDirtySrcValid) then begin
 
2335
        MoveCursorToCleanPos(IdentEndPos);
 
2336
        InFrontOfDirective:=(CurPos.StartPos<SrcLen) and (Src[CurPos.StartPos]='{')
 
2337
                            and (Src[CurPos.StartPos+1]='$');
 
2338
        ReadNextAtom;
 
2339
 
 
2340
        // check end of line
 
2341
        if (not InFrontOfDirective)
 
2342
        and (not PositionsInSameLine(Src,IdentEndPos,CurPos.StartPos)) then
 
2343
          CurrentIdentifierList.ContextFlags:=
 
2344
            CurrentIdentifierList.ContextFlags+[ilcfEndOfLine];
 
2345
 
 
2346
        CurrentIdentifierList.StartAtomBehind:=CurPos;
 
2347
        // check if a semicolon is needed or forbidden at the end
 
2348
        if InFrontOfDirective
 
2349
        or (CurrentIdentifierList.StartBracketLvl>0)
 
2350
        or (CurPos.Flag in [cafSemicolon, cafEqual, cafColon, cafComma,
 
2351
                   cafPoint, cafRoundBracketOpen, cafRoundBracketClose,
 
2352
                   cafEdgedBracketOpen, cafEdgedBracketClose])
 
2353
        or ((CurPos.Flag in [cafWord,cafNone])
 
2354
            and (UpAtomIs('ELSE')
 
2355
                 or UpAtomIs('THEN')
 
2356
                 or UpAtomIs('DO')
 
2357
                 or UpAtomIs('TO')
 
2358
                 or UpAtomIs('OF')
 
2359
                 or WordIsBinaryOperator.DoItCaseInsensitive(Src,
 
2360
                          CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
 
2361
        then begin
 
2362
          // do not add semicolon
 
2363
          CurrentIdentifierList.ContextFlags:=
 
2364
            CurrentIdentifierList.ContextFlags+[ilcfNoEndSemicolon];
 
2365
        end;
 
2366
        // check if in statement
 
2367
        if (ilcfStartInStatement in CurrentIdentifierList.ContextFlags) then
 
2368
        begin
 
2369
          // check if a semicolon is needed at the end
 
2370
          if (not (ilcfNoEndSemicolon in CurrentIdentifierList.ContextFlags))
 
2371
          then begin
 
2372
            // check if a semicolon is needed at the end
 
2373
            if (CurPos.Flag in [cafEnd])
 
2374
            or WordIsBlockKeyWord.DoItCaseInsensitive(Src,
 
2375
                                  CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
 
2376
            or ((CurPos.Flag=cafWord)
 
2377
                and (not PositionsInSameLine(Src,IdentEndPos,CurPos.StartPos)))
 
2378
            then begin
 
2379
              // add semicolon
 
2380
              CurrentIdentifierList.ContextFlags:=
 
2381
                CurrentIdentifierList.ContextFlags+[ilcfNeedsEndSemicolon];
 
2382
            end;
 
2383
          end;
 
2384
        end;
 
2385
        // check missing 'do' after 'with'
 
2386
        if CurrentIdentifierList.StartUpAtomInFrontIs('WITH')
 
2387
        and (not CurrentIdentifierList.StartUpAtomBehindIs('DO'))
 
2388
        and (CurrentIdentifierList.StartBracketLvl=0)
 
2389
        and (not (CurrentIdentifierList.StartAtomBehind.Flag in
 
2390
               [cafComma,cafPoint,cafRoundBracketOpen,cafEdgedBracketOpen]))
 
2391
        and (not CurrentIdentifierList.StartUpAtomBehindIs('^'))
 
2392
        then
 
2393
          CurrentIdentifierList.ContextFlags:=
 
2394
            CurrentIdentifierList.ContextFlags+[ilcfNeedsDo];
 
2395
      end else begin
 
2396
        // end of source
 
2397
        CurrentIdentifierList.ContextFlags:=
 
2398
          CurrentIdentifierList.ContextFlags+[ilcfEndOfLine];
 
2399
      end;
 
2400
 
 
2401
      // check for procedure/method declaration context
 
2402
      CheckProcedureDeclarationContext;
 
2403
 
 
2404
      // add useful identifiers
 
2405
      {$IFDEF CTDEBUG}
 
2406
      DebugLn('TIdentCompletionTool.GatherIdentifiers G');
 
2407
      {$ENDIF}
 
2408
      GatherUsefulIdentifiers(IdentStartPos,CursorContext,BeautifyCodeOptions);
 
2409
    end;
 
2410
 
 
2411
    Result:=true;
 
2412
  finally
 
2413
    FreeListOfPFindContext(FICTClassAndAncestors);
 
2414
    FreeAndNil(FIDCTFoundPublicProperties);
 
2415
    Params.Free;
 
2416
    ClearIgnoreErrorAfter;
 
2417
    DeactivateGlobalWriteLock;
 
2418
    CurrentIdentifierList:=nil;
 
2419
  end;
 
2420
  {$IFDEF CTDEBUG}
 
2421
  DebugLn('TIdentCompletionTool.GatherIdentifiers END');
 
2422
  {$ENDIF}
 
2423
end;
 
2424
 
 
2425
function TIdentCompletionTool.FindCodeContext(const CursorPos: TCodeXYPosition;
 
2426
  out CodeContexts: TCodeContextInfo): boolean;
 
2427
var
 
2428
  CleanCursorPos: integer;
 
2429
  CursorNode: TCodeTreeNode;
 
2430
  Params: TFindDeclarationParams;
 
2431
 
 
2432
  procedure AddPredefinedProcs(CurrentContexts: TCodeContextInfo;
 
2433
    ProcNameAtom: TAtomPosition);
 
2434
 
 
2435
    procedure AddCompilerProc(const AProcName: string;
 
2436
      const Params: string; const ResultType: string = '');
 
2437
    var
 
2438
      i: LongInt;
 
2439
      Item: TCodeContextInfoItem;
 
2440
    begin
 
2441
      if CompareIdentifiers(PChar(AProcName),@Src[ProcNameAtom.StartPos])<>0
 
2442
      then exit;
 
2443
      i:=CurrentContexts.AddCompilerProc;
 
2444
      Item:=CurrentContexts[i];
 
2445
      Item.ProcName:=AProcName;
 
2446
      Item.ResultType:=ResultType;
 
2447
      Item.Params:=TStringList.Create;
 
2448
      Item.Params.Delimiter:=';';
 
2449
      Item.Params.StrictDelimiter:=true;
 
2450
      Item.Params.DelimitedText:=Params;
 
2451
    end;
 
2452
 
 
2453
  begin
 
2454
    MoveCursorToAtomPos(ProcNameAtom);
 
2455
    ReadPriorAtom;
 
2456
    if (CurPos.Flag in [cafEnd,cafSemicolon,cafColon,
 
2457
      cafRoundBracketOpen,cafEdgedBracketOpen])
 
2458
    or UpAtomIs('BEGIN')
 
2459
    or UpAtomIs('TRY') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
 
2460
    or UpAtomIs('REPEAT') or UpAtomIs('ASM') then begin
 
2461
      // see fpc/compiler/psystem.pp
 
2462
      AddCompilerProc('Assert','Condition:Boolean;const Message:String');
 
2463
      AddCompilerProc('Assigned','P:Pointer','Boolean');
 
2464
      AddCompilerProc('Addr','var X','Pointer');
 
2465
      AddCompilerProc('BitSizeOf','Identifier','Integer');
 
2466
      AddCompilerProc('Concat','S1:String;S2:String[...;Sn:String]', 'String');
 
2467
      AddCompilerProc('Copy','const S:String;FromPosition,Count:Integer', 'String');
 
2468
      AddCompilerProc('Dec','var X:Ordinal;N:Integer=1');
 
2469
      AddCompilerProc('Dispose','var X:Pointer');
 
2470
      AddCompilerProc('Exclude','var S:Set;X:Ordinal');
 
2471
      AddCompilerProc('Exit','ResultValue:Ordinal=Result');
 
2472
      AddCompilerProc('Finalize','var X');
 
2473
      AddCompilerProc('get_frame','','Pointer');
 
2474
      AddCompilerProc('High','Arg:TypeOrVariable','Ordinal');
 
2475
      AddCompilerProc('Inc','var X:Ordinal;N:Integer=1');
 
2476
      AddCompilerProc('Include','var S:Set;X:Ordinal');
 
2477
      AddCompilerProc('Initialize','var X');
 
2478
      AddCompilerProc('Length','S:String','Integer');
 
2479
      AddCompilerProc('Length','A:Array','Integer');
 
2480
      AddCompilerProc('Low','Arg:TypeOrVariable','Ordinal');
 
2481
      AddCompilerProc('New','var X:Pointer');
 
2482
      AddCompilerProc('Ofs','var X','LongInt');
 
2483
      AddCompilerProc('Ord','X:Ordinal', 'Integer');
 
2484
      AddCompilerProc('Pack','A:Array;N:Integer;var A:Array');
 
2485
      AddCompilerProc('Pred','X:Ordinal', 'Ordinal');
 
2486
      AddCompilerProc('Read','');
 
2487
      AddCompilerProc('ReadLn','');
 
2488
      AddCompilerProc('ReadStr','S:String;var Args:Arguments');
 
2489
      AddCompilerProc('Seg','var X','LongInt');
 
2490
      AddCompilerProc('SetLength','var S:String;NewLength:Integer');
 
2491
      AddCompilerProc('SetLength','var A:Array;NewLength:Integer');
 
2492
      AddCompilerProc('SizeOf','Identifier','Integer');
 
2493
      AddCompilerProc('Slice','var A:Array;Count:Integer','Array');
 
2494
      AddCompilerProc('Str','const X[:Width[:Decimals]];var S:String');
 
2495
      AddCompilerProc('Succ','X:Ordinal', 'Ordinal');
 
2496
      AddCompilerProc('TypeInfo','Identifier', 'Pointer');
 
2497
      AddCompilerProc('TypeOf','Identifier', 'Pointer');
 
2498
      AddCompilerProc('Val','S:String;var V;var Code:Integer');
 
2499
      AddCompilerProc('Unaligned','var X','var');
 
2500
      AddCompilerProc('Unpack','A:Array;var A:Array;N:Integer');
 
2501
      AddCompilerProc('Write','Args:Arguments');
 
2502
      AddCompilerProc('WriteLn','Args:Arguments');
 
2503
      AddCompilerProc('WriteStr','var S:String;Args:Arguments');
 
2504
    end;
 
2505
  end;
 
2506
 
 
2507
  function CheckContextIsParameter(var Ok: boolean): boolean;
 
2508
  // returns true, on error or context is parameter
 
2509
  var
 
2510
    VarNameAtom, ProcNameAtom: TAtomPosition;
 
2511
    ParameterIndex: integer;
 
2512
    GatherContext: TFindContext;
 
2513
    ContextExprStartPos: LongInt;
 
2514
    StartInSubContext: Boolean;
 
2515
  begin
 
2516
    Result:=false;
 
2517
    // check if in a begin..end block
 
2518
    if CursorNode.GetNodeOfTypes([ctnBeginBlock,ctnInitialization,ctnFinalization])=nil
 
2519
    then begin
 
2520
      DebugLn(['TIdentCompletionTool.FindCodeContext.CheckContextIsParameter not in a begin block']);
 
2521
      exit;
 
2522
    end;
 
2523
    // check if cursor is in a parameter list
 
2524
    if not CheckParameterSyntax(CursorNode, CleanCursorPos,
 
2525
                                VarNameAtom, ProcNameAtom, ParameterIndex)
 
2526
    then begin
 
2527
      if VarNameAtom.StartPos=0 then ;
 
2528
      //DebugLn(['TIdentCompletionTool.FindCodeContext.CheckContextIsParameter not in a parameter list']);
 
2529
      exit;
 
2530
    end;
 
2531
    //DebugLn('CheckContextIsParameter Variable=',GetAtom(VarNameAtom),' Proc=',GetAtom(ProcNameAtom),' ParameterIndex=',dbgs(ParameterIndex));
 
2532
    
 
2533
    // it is a parameter -> create context
 
2534
    Result:=true;
 
2535
    if CurrentIdentifierContexts=nil then
 
2536
      CurrentIdentifierContexts:=TCodeContextInfo.Create;
 
2537
    CurrentIdentifierContexts.Tool:=Self;
 
2538
    CurrentIdentifierContexts.ParameterIndex:=ParameterIndex+1;
 
2539
    CurrentIdentifierContexts.ProcNameAtom:=ProcNameAtom;
 
2540
    CurrentIdentifierContexts.ProcName:=GetAtom(ProcNameAtom);
 
2541
 
 
2542
    AddPredefinedProcs(CurrentIdentifierContexts,ProcNameAtom);
 
2543
 
 
2544
    MoveCursorToAtomPos(ProcNameAtom);
 
2545
    ReadNextAtom; // read opening bracket
 
2546
    CurrentIdentifierContexts.StartPos:=CurPos.EndPos;
 
2547
    // read closing bracket
 
2548
    if ReadTilBracketClose(false) then
 
2549
      CurrentIdentifierContexts.EndPos:=CurPos.StartPos
 
2550
    else
 
2551
      CurrentIdentifierContexts.EndPos:=SrcLen+1;
 
2552
 
 
2553
    FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode,
 
2554
                          GatherContext,ContextExprStartPos,StartInSubContext);
 
2555
    if ContextExprStartPos=0 then ;
 
2556
    //DebugLn(['CheckContextIsParameter StartInSubContext=',StartInSubContext,' ',GatherContext.Node.DescAsString,' "',copy(GatherContext.Tool.Src,GatherContext.Node.StartPos-20,25),'"']);
 
2557
 
 
2558
    // gather declarations of all parameter lists
 
2559
    Params.ContextNode:=GatherContext.Node;
 
2560
    Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CollectAllContexts);
 
2561
    Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
 
2562
    if not StartInSubContext then
 
2563
      Include(Params.Flags,fdfSearchInParentNodes);
 
2564
    CurrentIdentifierList.Context:=GatherContext;
 
2565
    //DebugLn('CheckContextIsParameter searching procedures, properties and variables ...');
 
2566
    GatherContext.Tool.FindIdentifierInContext(Params);
 
2567
    //DebugLn('CheckContextIsParameter END');
 
2568
    Ok:=true;
 
2569
  end;
 
2570
 
 
2571
var
 
2572
  IdentifierList: TIdentifierList;
 
2573
  IdentStartPos, IdentEndPos: integer;
 
2574
begin
 
2575
  CodeContexts:=nil;
 
2576
  Result:=false;
 
2577
 
 
2578
  IdentifierList:=nil;
 
2579
  CurrentIdentifierContexts:=CodeContexts;
 
2580
 
 
2581
  ActivateGlobalWriteLock;
 
2582
  Params:=TFindDeclarationParams.Create;
 
2583
  try
 
2584
    InitCollectIdentifiers(CursorPos,IdentifierList);
 
2585
    ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
 
2586
                                   IdentStartPos,IdentEndPos);
 
2587
    if IdentStartPos=0 then ;
 
2588
    if IdentEndPos=0 then ;
 
2589
 
 
2590
    // find class and ancestors if existing (needed for protected identifiers)
 
2591
    FindContextClassAndAncestors(CursorPos,FICTClassAndAncestors);
 
2592
 
 
2593
    if CursorNode<>nil then begin
 
2594
      if not CheckContextIsParameter(Result) then begin
 
2595
        //DebugLn(['TIdentCompletionTool.FindCodeContext cursor not at parameter']);
 
2596
        exit;
 
2597
      end;
 
2598
    end;
 
2599
 
 
2600
    if CurrentIdentifierContexts=nil then begin
 
2601
      // create default
 
2602
      AddCollectionContext(Self,CursorNode);
 
2603
    end;
 
2604
 
 
2605
    Result:=true;
 
2606
  finally
 
2607
    if Result then begin
 
2608
      CodeContexts:=CurrentIdentifierContexts;
 
2609
      CurrentIdentifierContexts:=nil;
 
2610
    end else begin
 
2611
      FreeAndNil(CurrentIdentifierContexts);
 
2612
    end;
 
2613
    FreeListOfPFindContext(FICTClassAndAncestors);
 
2614
    FreeAndNil(FIDCTFoundPublicProperties);
 
2615
    Params.Free;
 
2616
    ClearIgnoreErrorAfter;
 
2617
    DeactivateGlobalWriteLock;
 
2618
    FreeAndNil(CurrentIdentifierList);
 
2619
  end;
 
2620
end;
 
2621
 
 
2622
function TIdentCompletionTool.FindAbstractMethods(
 
2623
  const CursorPos: TCodeXYPosition; out ListOfPCodeXYPosition: TFPList;
 
2624
  SkipAbstractsInStartClass: boolean): boolean;
 
2625
var
 
2626
  CleanCursorPos: integer;
 
2627
  CursorNode: TCodeTreeNode;
 
2628
  Params: TFindDeclarationParams;
 
2629
  AVLNode: TAVLTreeNode;
 
2630
  NodeExt: TCodeTreeNodeExtension;
 
2631
  ATool: TFindDeclarationTool;
 
2632
  ANode: TCodeTreeNode;
 
2633
  ProcXYPos: TCodeXYPosition;
 
2634
  Skip: Boolean;
 
2635
  ClassNode: TCodeTreeNode;
 
2636
begin
 
2637
  Result:=false;
 
2638
  ListOfPCodeXYPosition:=nil;
 
2639
  ActivateGlobalWriteLock;
 
2640
  Params:=nil;
 
2641
  try
 
2642
    BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
 
2643
                            [btSetIgnoreErrorPos]);
 
2644
 
 
2645
    // find node at position
 
2646
    CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
 
2647
 
 
2648
    // if cursor is on type node, find class node
 
2649
    if CursorNode.Desc=ctnTypeDefinition then
 
2650
      CursorNode:=CursorNode.FirstChild
 
2651
    else if CursorNode.Desc=ctnGenericType then
 
2652
      CursorNode:=CursorNode.LastChild
 
2653
    else
 
2654
      CursorNode:=FindClassOrInterfaceNode(CursorNode);
 
2655
    if (CursorNode=nil)
 
2656
    or (not (CursorNode.Desc in AllClassObjects))
 
2657
    or ((CursorNode.SubDesc and ctnsForwardDeclaration)>0) then begin
 
2658
      MoveCursorToCleanPos(CleanCursorPos);
 
2659
      RaiseException('TIdentCompletionTool.FindAbstractMethods cursor is not in a class');
 
2660
    end;
 
2661
    ClassNode:=CursorNode;
 
2662
 
 
2663
    Params:=TFindDeclarationParams.Create;
 
2664
    // gather all identifiers in context
 
2665
    Params.ContextNode:=ClassNode;
 
2666
    Params.SetIdentifier(Self,nil,@CollectMethods);
 
2667
    Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
 
2668
    InitFoundMethods;
 
2669
    FindIdentifierInContext(Params);
 
2670
 
 
2671
    if FIDTFoundMethods<>nil then begin
 
2672
      AVLNode:=FIDTFoundMethods.FindLowest;
 
2673
      while AVLNode<>nil do begin
 
2674
        NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
 
2675
        ANode:=NodeExt.Node;
 
2676
        ATool:=TFindDeclarationTool(NodeExt.Data);
 
2677
        //DebugLn(['TIdentCompletionTool.FindAbstractMethods ',NodeExt.Txt,' ',ATool.ProcNodeHasSpecifier(ANode,psABSTRACT)]);
 
2678
        Skip:=false;
 
2679
        if not ATool.ProcNodeHasSpecifier(ANode,psABSTRACT) then
 
2680
          Skip:=true;
 
2681
        if SkipAbstractsInStartClass and (ANode.HasAsParent(ClassNode)) then
 
2682
          Skip:=true;
 
2683
        if not Skip then begin
 
2684
          if not ATool.CleanPosToCaret(ANode.StartPos,ProcXYPos) then
 
2685
            raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency');
 
2686
          AddCodePosition(ListOfPCodeXYPosition,ProcXYPos);
 
2687
        end;
 
2688
        AVLNode:=FIDTFoundMethods.FindSuccessor(AVLNode);
 
2689
      end;
 
2690
    end;
 
2691
 
 
2692
    Result:=true;
 
2693
  finally
 
2694
    Params.Free;
 
2695
    ClearFoundMethods;
 
2696
    DeactivateGlobalWriteLock;
 
2697
  end;
 
2698
end;
 
2699
 
 
2700
function TIdentCompletionTool.GetValuesOfCaseVariable(
 
2701
  const CursorPos: TCodeXYPosition; List: TStrings): boolean;
 
2702
var
 
2703
  CleanCursorPos: integer;
 
2704
  CursorNode: TCodeTreeNode;
 
2705
  CaseAtom: TAtomPosition;
 
2706
  Params: TFindDeclarationParams;
 
2707
  EndPos: LongInt;
 
2708
  ExprType: TExpressionType;
 
2709
  Node: TCodeTreeNode;
 
2710
  Tool: TFindDeclarationTool;
 
2711
begin
 
2712
  Result:=false;
 
2713
  ActivateGlobalWriteLock;
 
2714
  Params:=nil;
 
2715
  try
 
2716
    BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
 
2717
                           [btSetIgnoreErrorPos]);
 
2718
 
 
2719
    // find node at position
 
2720
    CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
 
2721
 
 
2722
    // find keyword case
 
2723
    MoveCursorToNodeStart(CursorNode);
 
2724
    CaseAtom:=CleanAtomPosition;
 
2725
    repeat
 
2726
      ReadNextAtom;
 
2727
      if UpAtomIs('CASE') then
 
2728
        CaseAtom:=CurPos
 
2729
    until (CurPos.EndPos>SrcLen) or (CurPos.EndPos>CleanCursorPos);
 
2730
    if CaseAtom.StartPos<1 then exit;
 
2731
 
 
2732
    // find case variable
 
2733
    EndPos:=FindEndOfExpression(CaseAtom.EndPos);
 
2734
    if EndPos>CleanCursorPos then
 
2735
      EndPos:=CleanCursorPos;
 
2736
    //DebugLn(['TIdentCompletionTool.GetValuesOfCaseVariable Expr=',dbgstr(copy(Src,CaseAtom.EndPos,EndPos-CaseAtom.EndPos))]);
 
2737
 
 
2738
    Params:=TFindDeclarationParams.Create;
 
2739
    Params.ContextNode:=CursorNode;
 
2740
    Params.Flags:=fdfDefaultForExpressions+[fdfFunctionResult];
 
2741
    ExprType:=FindExpressionTypeOfTerm(CaseAtom.EndPos,EndPos,Params,true);
 
2742
    //DebugLn(['TIdentCompletionTool.GetValuesOfCaseVariable Type=',ExprTypeToString(ExprType)]);
 
2743
 
 
2744
    if ExprType.Desc=xtContext then begin
 
2745
      // resolve aliases and properties
 
2746
      Params.Clear;
 
2747
      Params.Flags:=fdfDefaultForExpressions;
 
2748
      ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,
 
2749
                                 ExprType.Context.Node);
 
2750
    end;
 
2751
 
 
2752
    case ExprType.Desc of
 
2753
 
 
2754
    xtBoolean,xtByteBool,xtWordBool,xtLongBool,xtQWordBool:
 
2755
      begin
 
2756
        List.Add('True');
 
2757
        List.Add('False');
 
2758
      end;
 
2759
 
 
2760
    xtContext:
 
2761
      begin
 
2762
        Node:=ExprType.Context.Node;
 
2763
        Tool:=ExprType.Context.Tool;
 
2764
        if Node=nil then exit;
 
2765
        case Node.Desc of
 
2766
 
 
2767
        ctnEnumerationType:
 
2768
          begin
 
2769
            Node:=Node.FirstChild;
 
2770
            while Node<>nil do begin
 
2771
              List.Add(GetIdentifier(@Tool.Src[Node.StartPos]));
 
2772
              Node:=Node.NextBrother;
 
2773
            end;
 
2774
          end;
 
2775
 
 
2776
        else
 
2777
          debugln(['TIdentCompletionTool.GetValuesOfCaseVariable not an enum: ',Node.DescAsString]);
 
2778
          exit;
 
2779
        end;
 
2780
      end;
 
2781
    else
 
2782
      exit;
 
2783
    end;
 
2784
 
 
2785
    Result:=true;
 
2786
  finally
 
2787
    Params.Free;
 
2788
    DeactivateGlobalWriteLock;
 
2789
  end;
 
2790
end;
 
2791
 
 
2792
procedure TIdentCompletionTool.CalcMemSize(Stats: TCTMemStats);
 
2793
var
 
2794
  Node: TAVLTreeNode;
 
2795
  Ext: TCodeTreeNodeExtension;
 
2796
  m: PtrUint;
 
2797
begin
 
2798
  inherited CalcMemSize(Stats);
 
2799
  if FICTClassAndAncestors<>nil then
 
2800
    Stats.Add('TIdentCompletionTool.ClassAndAncestors',
 
2801
        FICTClassAndAncestors.Count*(SizeOf(TAVLTreeNode)+SizeOf(TCodeXYPosition)));
 
2802
  if FIDCTFoundPublicProperties<>nil then
 
2803
    Stats.Add('TIdentCompletionTool.FoundPublicProperties',
 
2804
              FIDCTFoundPublicProperties.Count*SizeOf(TAVLTreeNode));
 
2805
  if FIDTFoundMethods<>nil then begin
 
2806
    m:=PtrUint(FIDTFoundMethods.Count)*SizeOf(TAVLTreeNode);
 
2807
    Node:=FIDTFoundMethods.FindLowest;
 
2808
    while Node<>nil do begin
 
2809
      Ext:=TCodeTreeNodeExtension(Node.Data);
 
2810
      inc(m,Ext.CalcMemSize);
 
2811
      Node:=FIDTFoundMethods.FindSuccessor(Node);
 
2812
    end;
 
2813
    STats.Add('TIdentCompletionTool.FoundMethods',m);
 
2814
  end;
 
2815
  if CurrentIdentifierList<>nil then
 
2816
    Stats.Add('TIdentCompletionTool.CurrentIdentifierList',
 
2817
      CurrentIdentifierList.CalcMemSize);
 
2818
  if CurrentIdentifierContexts<>nil then
 
2819
    Stats.Add('TIdentCompletionTool.CurrentContexts',
 
2820
              CurrentIdentifierContexts.CalcMemSize);
 
2821
end;
 
2822
 
 
2823
{ TIdentifierListItem }
 
2824
 
 
2825
function TIdentifierListItem.GetParamTypeList: string;
 
2826
var
 
2827
  ANode: TCodeTreeNode;
 
2828
begin
 
2829
  if not (iliParamTypeListValid in Flags) then begin
 
2830
    // Note: if you implement param lists for other than ctnProcedure, check
 
2831
    //       CompareParamList
 
2832
    ANode:=Node;
 
2833
    if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
 
2834
      FParamTypeList:=Tool.ExtractProcHead(ANode,
 
2835
         [phpWithoutClassKeyword,phpWithoutClassName,
 
2836
          phpWithoutName,phpInUpperCase]);
 
2837
      //debugln('TIdentifierListItem.GetParamTypeList A ',GetIdentifier(Identifier),' ',Tool.MainFilename,' ',dbgs(CurNode.StartPos));
 
2838
    end else
 
2839
      FParamTypeList:='';
 
2840
    Include(Flags,iliParamTypeListValid);
 
2841
  end;
 
2842
  Result:=FParamTypeList;
 
2843
end;
 
2844
 
 
2845
function TIdentifierListItem.GetParamNameList: string;
 
2846
var
 
2847
  ANode: TCodeTreeNode;
 
2848
begin
 
2849
  if not (iliParamNameListValid in Flags) then begin
 
2850
    // Note: if you implement param lists for other than ctnProcedure, check
 
2851
    //       CompareParamList
 
2852
    ANode:=Node;
 
2853
    if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
 
2854
      FParamNameList:=Tool.ExtractProcHead(ANode,
 
2855
         [phpWithoutClassKeyword,phpWithoutClassName,
 
2856
          phpWithoutName,phpInUpperCase,phpWithParameterNames]);
 
2857
      //debugln('TIdentifierListItem.GetParamNameList A ',GetIdentifier(Identifier),' ',Tool.MainFilename,' ',dbgs(CurNode.StartPos));
 
2858
    end else
 
2859
      FParamNameList:='';
 
2860
    Include(Flags,iliParamNameListValid);
 
2861
  end;
 
2862
  Result:=FParamNameList;
 
2863
end;
 
2864
 
 
2865
function TIdentifierListItem.GetNode: TCodeTreeNode;
 
2866
begin
 
2867
  Result:=nil;
 
2868
  if Tool=nil then
 
2869
    exit;
 
2870
 
 
2871
  if (iliNodeValid in Flags)
 
2872
  and (FToolNodesDeletedStep<>Tool.NodesDeletedChangeStep) then
 
2873
    Exclude(Flags,iliNodeValid);
 
2874
 
 
2875
  if (not (iliNodeValid in Flags)) then begin
 
2876
    if iliNodeHashValid in Flags then begin
 
2877
      RestoreNode;
 
2878
      if (iliNodeValid in Flags) then begin
 
2879
        Result:=FNode;
 
2880
      end;
 
2881
    end;
 
2882
  end else begin
 
2883
    if FToolNodesDeletedStep=Tool.NodesDeletedChangeStep then begin
 
2884
      Result:=FNode;
 
2885
    end else begin
 
2886
      if not (iliNodeGoneWarned in Flags) then begin
 
2887
        DebugLn(['TIdentifierListItem.GetNode node ',Identifier,' is gone from ',Tool.MainFilename]);
 
2888
        Include(Flags,iliNodeGoneWarned);
 
2889
      end;
 
2890
      FNode:=nil;
 
2891
    end;
 
2892
  end;
 
2893
end;
 
2894
 
 
2895
procedure TIdentifierListItem.SetNode(const AValue: TCodeTreeNode);
 
2896
 
 
2897
  procedure RaiseToolMissing;
 
2898
  begin
 
2899
    raise Exception.Create('TIdentifierListItem.SetNode Node without Tool');
 
2900
  end;
 
2901
 
 
2902
begin
 
2903
  FNode:=AValue;
 
2904
  Include(Flags,iliNodeValid);
 
2905
  Exclude(Flags,iliNodeHashValid);
 
2906
  if (FNode<>nil) and (Tool=nil) then
 
2907
    RaiseToolMissing;
 
2908
  if (Tool<>nil) then
 
2909
    FToolNodesDeletedStep:=Tool.NodesDeletedChangeStep;
 
2910
end;
 
2911
 
 
2912
procedure TIdentifierListItem.SetParamTypeList(const AValue: string);
 
2913
begin
 
2914
  FParamTypeList:=AValue;
 
2915
  Include(Flags,iliParamTypeListValid);
 
2916
end;
 
2917
 
 
2918
procedure TIdentifierListItem.SetParamNameList(const AValue: string);
 
2919
begin
 
2920
  FParamNameList:=AValue;
 
2921
  Include(Flags,iliParamNameListValid);
 
2922
end;
 
2923
 
 
2924
procedure TIdentifierListItem.SetResultType(const AValue: string);
 
2925
begin
 
2926
  FResultType := AValue;
 
2927
  Include(Flags, iliResultTypeValid);
 
2928
end;
 
2929
 
 
2930
function TIdentifierListItem.AsString: string;
 
2931
var
 
2932
  ANode: TCodeTreeNode;
 
2933
begin
 
2934
  WriteStr(Result, Compatibility);
 
2935
  if HasChilds then
 
2936
    Result:=Result+' HasChilds'
 
2937
  else
 
2938
    Result:=Result+' HasNoChilds';
 
2939
  Result:=Result+' History='+IntToStr(HistoryIndex);
 
2940
  Result:=Result+' Ident='+Identifier;
 
2941
  Result:=Result+' Lvl='+IntToStr(Level);
 
2942
  if Tool<>nil then
 
2943
    Result:=Result+' File='+Tool.MainFilename;
 
2944
  ANode:=Node;
 
2945
  if ANode<>nil then
 
2946
    Result:=Result+' Node='+ANode.DescAsString
 
2947
      +' "'+StringToPascalConst(copy(Tool.Src,ANode.StartPos,50))+'"';
 
2948
end;
 
2949
 
 
2950
function TIdentifierListItem.GetDesc: TCodeTreeNodeDesc;
 
2951
var
 
2952
  ANode: TCodeTreeNode;
 
2953
begin
 
2954
  ANode:=Node;
 
2955
  if ANode<>nil then
 
2956
    Result:=ANode.Desc
 
2957
  else
 
2958
    Result:=DefaultDesc;
 
2959
end;
 
2960
 
 
2961
constructor TIdentifierListItem.Create(
 
2962
  NewCompatibility: TIdentifierCompatibility; NewHasChilds: boolean;
 
2963
  NewHistoryIndex: integer; NewIdentifier: PChar; NewLevel: integer;
 
2964
  NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
 
2965
  NewDefaultDesc: TCodeTreeNodeDesc);
 
2966
begin
 
2967
  Compatibility:=NewCompatibility;
 
2968
  if NewHasChilds then Include(FLags,iliHasChilds);
 
2969
  HistoryIndex:=NewHistoryIndex;
 
2970
  Identifier:=GetIdentifier(NewIdentifier);
 
2971
  Level:=NewLevel;
 
2972
  Tool:=NewTool;
 
2973
  Node:=NewNode;
 
2974
  DefaultDesc:=NewDefaultDesc;
 
2975
  BaseExprType:=CleanExpressionType;
 
2976
end;
 
2977
 
 
2978
function TIdentifierListItem.IsProcNodeWithParams: boolean;
 
2979
var
 
2980
  ANode: TCodeTreeNode;
 
2981
  StartPos: Integer;
 
2982
begin
 
2983
  Result:=(GetDesc=ctnProcedure);
 
2984
  if not Result then exit;
 
2985
  if (iliParamNameListValid in Flags) then begin
 
2986
    StartPos:=1;
 
2987
    while (StartPos<=length(FParamTypeList))
 
2988
    and (FParamTypeList[StartPos] in [' ',#9,'(','[']) do
 
2989
      inc(StartPos);
 
2990
    if (StartPos<=length(FParamTypeList))
 
2991
    and (FParamTypeList[StartPos] in [')',']',';']) then
 
2992
      exit(false)
 
2993
    else
 
2994
      exit(true);
 
2995
  end else if (iliParamTypeListValid in Flags) then begin
 
2996
    // the type list does not contain names
 
2997
    // so a () could be empty or (var buf)
 
2998
    StartPos:=1;
 
2999
    while (StartPos<=length(FParamTypeList))
 
3000
    and (FParamTypeList[StartPos] in [' ',#9,'(','[']) do
 
3001
      inc(StartPos);
 
3002
    if (StartPos<=length(FParamTypeList))
 
3003
    and (not (FParamTypeList[StartPos] in [')',']',';'])) then
 
3004
      exit(true);
 
3005
  end;
 
3006
  ANode:=Node;
 
3007
  Result:=(ANode<>nil) and Tool.ProcNodeHasParamList(ANode);
 
3008
end;
 
3009
 
 
3010
function TIdentifierListItem.IsPropertyWithParams: boolean;
 
3011
var
 
3012
  ANode: TCodeTreeNode;
 
3013
begin
 
3014
  if not (iliHasParamListValid in Flags) then begin
 
3015
    Include(Flags,iliHasParamListValid);
 
3016
    ANode:=Node;
 
3017
    if (ANode<>nil) and Tool.PropertyNodeHasParamList(ANode) then
 
3018
      Include(Flags,iliHasParamList)
 
3019
    else
 
3020
      Exclude(Flags,iliHasParamList);
 
3021
  end;
 
3022
  Result:=iliHasParamList in Flags;
 
3023
end;
 
3024
 
 
3025
function TIdentifierListItem.IsPropertyReadOnly: boolean;
 
3026
var
 
3027
  ANode: TCodeTreeNode;
 
3028
begin
 
3029
  if not (iliIsReadOnlyValid in Flags) then begin
 
3030
    Include(Flags,iliIsReadOnlyValid);
 
3031
    ANode:=Node;
 
3032
    if (ANode<>nil) and Tool.PropertyHasSpecifier(ANode,'read',false)
 
3033
    and not Tool.PropertyHasSpecifier(ANode,'write',false) then
 
3034
      Include(Flags,iliIsReadOnly)
 
3035
    else
 
3036
      Exclude(Flags,iliIsReadOnly);
 
3037
  end;
 
3038
  Result:=iliIsReadOnly in Flags;
 
3039
end;
 
3040
 
 
3041
function TIdentifierListItem.GetHintModifiers: TPascalHintModifiers;
 
3042
var
 
3043
  ANode: TCodeTreeNode;
 
3044
begin
 
3045
  Result:=[];
 
3046
  if not (iliHintModifiersValid in Flags) then begin
 
3047
    Include(Flags,iliHintModifiersValid);
 
3048
    ANode:=Node;
 
3049
    if ANode<>nil then begin
 
3050
      Result:=Tool.GetHintModifiers(ANode);
 
3051
      if phmDeprecated in Result then Include(Flags,iliIsDeprecated);
 
3052
      if phmPlatform in Result then Include(Flags,iliIsPlatform);
 
3053
      if phmLibrary in Result then Include(Flags,iliIsLibrary);
 
3054
      if phmUnimplemented in Result then Include(Flags,iliIsUnimplemented);
 
3055
      if phmExperimental in Result then Include(Flags,iliIsExperimental);
 
3056
    end;
 
3057
  end else begin
 
3058
    if iliIsDeprecated in Flags then Include(Result,phmDeprecated);
 
3059
    if iliIsPlatform in Flags then Include(Result,phmPlatform);
 
3060
    if iliIsLibrary in Flags then Include(Result,phmLibrary);
 
3061
    if iliIsUnimplemented in Flags then Include(Result,phmUnimplemented);
 
3062
    if iliIsExperimental in Flags then Include(Result,phmExperimental);
 
3063
  end;
 
3064
end;
 
3065
 
 
3066
function TIdentifierListItem.CheckHasChilds: boolean;
 
3067
// returns true if test was successful
 
3068
var
 
3069
  ANode: TCodeTreeNode;
 
3070
begin
 
3071
  Result:=false;
 
3072
  if GetDesc in AllClasses then begin
 
3073
    Result:=true;
 
3074
    exit;
 
3075
  end;
 
3076
  ANode:=Node;
 
3077
  if ANode=nil then exit;
 
3078
  UpdateBaseContext;
 
3079
  if (BaseExprType.Desc=xtContext)
 
3080
    and (BaseExprType.Context.Node<>nil)
 
3081
    and (BaseExprType.Context.Node.Desc in AllClasses)
 
3082
  then
 
3083
    Include(Flags,iliHasChilds);
 
3084
  Result:=true;
 
3085
end;
 
3086
 
 
3087
function TIdentifierListItem.CanBeAssigned: boolean;
 
3088
var
 
3089
  ANode: TCodeTreeNode;
 
3090
begin
 
3091
  Result:=false;
 
3092
  ANode:=Node;
 
3093
  if (ANode=nil) then exit;
 
3094
  if (GetDesc=ctnVarDefinition) then
 
3095
    Result:=true;
 
3096
  if (ANode.Desc in [ctnProperty,ctnGlobalProperty]) then begin
 
3097
    if Tool.PropertyHasSpecifier(ANode,'write') then exit(true);
 
3098
    if Tool.PropNodeIsTypeLess(ANode) then begin
 
3099
      exit(true);// ToDo: search the real property definition
 
3100
    end;
 
3101
  end;
 
3102
end;
 
3103
 
 
3104
procedure TIdentifierListItem.UpdateBaseContext;
 
3105
var
 
3106
  Params: TFindDeclarationParams;
 
3107
  ANode: TCodeTreeNode;
 
3108
begin
 
3109
  if (iliBaseExprTypeValid in Flags) then exit;
 
3110
  Include(Flags,iliBaseExprTypeValid);
 
3111
  BaseExprType:=CleanExpressionType;
 
3112
  BaseExprType.Desc:=xtNone;
 
3113
  ANode:=Node;
 
3114
  if (ANode<>nil) and (Tool<>nil) then begin
 
3115
    Tool.ActivateGlobalWriteLock;
 
3116
    Params:=TFindDeclarationParams.Create;
 
3117
    try
 
3118
      if ANode.HasParentOfType(ctnGenericType) then exit;
 
3119
      BaseExprType.Context:=Tool.FindBaseTypeOfNode(Params,ANode);
 
3120
      if (BaseExprType.Context.Node<>nil) then
 
3121
        BaseExprType.Desc:=xtContext;
 
3122
    finally
 
3123
      Params.Free;
 
3124
      Tool.DeactivateGlobalWriteLock;
 
3125
    end;
 
3126
  end;
 
3127
end;
 
3128
 
 
3129
function TIdentifierListItem.HasChilds: boolean;
 
3130
begin
 
3131
  Result:=iliHasChilds in Flags;
 
3132
end;
 
3133
 
 
3134
function TIdentifierListItem.HasIndex: boolean;
 
3135
// check if edged bracket can be used []
 
3136
var
 
3137
  ANode: TCodeTreeNode;
 
3138
begin
 
3139
  if not (iliHasIndexValid in Flags) then begin
 
3140
    UpdateBaseContext;
 
3141
    if BaseExprType.Desc in (xtAllStringConvertibles+xtAllWideStringConvertibles)
 
3142
    then begin
 
3143
      // strings, widestrings and PChar
 
3144
      Include(Flags,iliHasIndex);
 
3145
    end else if (BaseExprType.Desc=xtContext) and (BaseExprType.Context.Node<>nil)
 
3146
    then begin
 
3147
      //debugln(['TIdentifierListItem.HasIndex ',BaseExprType.Context.Node.DescAsString]);
 
3148
      ANode:=BaseExprType.Context.Node;
 
3149
      case ANode.Desc of
 
3150
      ctnRangedArrayType,ctnOpenArrayType: Include(Flags,iliHasIndex);
 
3151
      end;
 
3152
    end;
 
3153
  end;
 
3154
  Result:=iliHasIndex in Flags;
 
3155
end;
 
3156
 
 
3157
function TIdentifierListItem.IsFunction: boolean;
 
3158
var
 
3159
  ANode: TCodeTreeNode;
 
3160
begin
 
3161
  if not (iliIsFunctionValid in Flags) then
 
3162
  begin
 
3163
    ANode := Node;
 
3164
    if (ANode <> nil) and Tool.NodeIsFunction(ANode) then
 
3165
      Include(Flags, iliIsFunction);
 
3166
    Include(Flags, iliIsFunctionValid);
 
3167
  end;
 
3168
  Result := iliIsFunction in Flags;
 
3169
end;
 
3170
 
 
3171
function TIdentifierListItem.IsContructor: boolean;
 
3172
var
 
3173
  ANode: TCodeTreeNode;
 
3174
begin
 
3175
  if not (iliIsConstructorValid in Flags) then
 
3176
  begin
 
3177
    ANode := Node;
 
3178
    if (ANode <> nil) and Tool.NodeIsConstructor(ANode) then
 
3179
      Include(Flags, iliIsConstructor);
 
3180
    Include(Flags, iliIsConstructorValid);
 
3181
  end;
 
3182
  Result := iliIsConstructor in Flags;
 
3183
end;
 
3184
 
 
3185
function TIdentifierListItem.IsDestructor: boolean;
 
3186
var
 
3187
  ANode: TCodeTreeNode;
 
3188
begin
 
3189
  if not (iliIsDestructorValid in Flags) then
 
3190
  begin
 
3191
    ANode := Node;
 
3192
    if (ANode <> nil) and Tool.NodeIsDestructor(ANode) then
 
3193
      Include(Flags, iliIsDestructor);
 
3194
    Include(Flags, iliIsDestructorValid);
 
3195
  end;
 
3196
  Result := iliIsDestructor in Flags;
 
3197
end;
 
3198
 
 
3199
function TIdentifierListItem.IsAbstractMethod: boolean;
 
3200
var
 
3201
  ANode: TCodeTreeNode;
 
3202
begin
 
3203
  if not (iliIsAbstractMethodValid in Flags) then begin
 
3204
    ANode:=Node;
 
3205
    if (ANode<>nil)
 
3206
    and Tool.ProcNodeHasSpecifier(ANode,psABSTRACT) then
 
3207
      Include(Flags,iliIsAbstractMethod);
 
3208
    Include(Flags,iliIsAbstractMethodValid);
 
3209
  end;
 
3210
  Result:=iliIsAbstractMethod in Flags;
 
3211
end;
 
3212
 
 
3213
function TIdentifierListItem.TryIsAbstractMethod: boolean;
 
3214
begin
 
3215
  try
 
3216
    Result:=IsAbstractMethod;
 
3217
  except
 
3218
    Result:=false;
 
3219
  end;
 
3220
end;
 
3221
 
 
3222
procedure TIdentifierListItem.Clear;
 
3223
begin
 
3224
  FParamTypeList:='';
 
3225
  FResultType:='';
 
3226
  Compatibility:=icompUnknown;
 
3227
  HistoryIndex:=0;
 
3228
  Identifier:='';
 
3229
  Level:=0;
 
3230
  FNode:=nil;
 
3231
  Tool:=nil;
 
3232
  DefaultDesc:=ctnNone;
 
3233
  Flags:=[];
 
3234
  BaseExprType:=CleanExpressionType;
 
3235
end;
 
3236
 
 
3237
procedure TIdentifierListItem.UnbindNode;
 
3238
begin
 
3239
  if FNode=nil then exit;
 
3240
  StoreNodeHash;
 
3241
  Exclude(Flags,iliNodeValid);
 
3242
  FNode:=nil;
 
3243
end;
 
3244
 
 
3245
procedure TIdentifierListItem.StoreNodeHash;
 
3246
begin
 
3247
  Include(Flags,iliNodeHashValid);
 
3248
  FNodeStartPos:=FNode.StartPos;
 
3249
  FNodeDesc:=FNode.Desc;
 
3250
  FNodeHash:=GetNodeHash(FNode);
 
3251
  //DebugLn(['TIdentifierListItem.StoreNodeHash ',Identifier,' Pos=',FNodeStartPos,' Hash=',FNodeHash]);
 
3252
end;
 
3253
 
 
3254
function TIdentifierListItem.RestoreNode: boolean;
 
3255
var
 
3256
  NewNode: TCodeTreeNode;
 
3257
  NewHash: String;
 
3258
begin
 
3259
  if not (iliNodeHashValid in Flags) then exit(true);
 
3260
  //DebugLn(['TIdentifierListItem.RestoreNode ',Identifier]);
 
3261
  NewNode:=Tool.BuildSubTreeAndFindDeepestNodeAtPos(FNodeStartPos,false);
 
3262
  Result:=false;
 
3263
  if (NewNode=nil) or (NewNode.StartPos<>FNodeStartPos)
 
3264
  or (NewNode.Desc<>FNodeDesc) then begin
 
3265
    DebugLn(['TIdentifierListItem.RestoreNode not found: ',Identifier]);
 
3266
    Exclude(Flags,iliNodeHashValid);
 
3267
    exit;
 
3268
  end;
 
3269
  NewHash:=GetNodeHash(NewNode);
 
3270
  if NewHash<>FNodeHash then begin
 
3271
    DebugLn(['TIdentifierListItem.RestoreNode hash changed: ',Identifier]);
 
3272
    Exclude(Flags,iliNodeHashValid);
 
3273
    exit;
 
3274
  end;
 
3275
  //DebugLn(['TIdentifierListItem.RestoreNode Success ',Identifier]);
 
3276
  Node:=NewNode;
 
3277
  Result:=true;
 
3278
end;
 
3279
 
 
3280
function TIdentifierListItem.GetNodeHash(ANode: TCodeTreeNode): string;
 
3281
var
 
3282
  StartPos: LongInt;
 
3283
  EndPos: LongInt;
 
3284
begin
 
3285
  case ANode.Desc of
 
3286
  ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnGenericType:
 
3287
    Result:=Tool.ExtractDefinitionName(ANode)
 
3288
  else
 
3289
    StartPos:=ANode.StartPos;
 
3290
    EndPos:=StartPos+20;
 
3291
    if EndPos>ANode.EndPos then EndPos:=ANode.EndPos;
 
3292
    Result:=copy(Tool.Src,StartPos,EndPos);
 
3293
  end;
 
3294
end;
 
3295
 
 
3296
function TIdentifierListItem.CompareParamList(CompareItem: TIdentifierListItem
 
3297
  ): integer;
 
3298
var
 
3299
  ANode: TCodeTreeNode;
 
3300
  CmpNode: TCodeTreeNode;
 
3301
begin
 
3302
  Result:=0;
 
3303
  if Self=CompareItem then exit;
 
3304
  ANode:=Node;
 
3305
  CmpNode:=CompareItem.Node;
 
3306
  if (ANode=CmpNode) then exit;
 
3307
  if (ANode=nil) or (CmpNode=nil) then exit;
 
3308
  if (ANode.Desc<>ctnProcedure) or (CmpNode.Desc<>ctnProcedure) then
 
3309
    exit;
 
3310
  {DbgOut('TIdentifierListItem.CompareParamList ',GetIdentifier(Identifier),'=',GetIdentifier(CompareItem.Identifier));
 
3311
  if Node<>nil then
 
3312
    DbgOut(' Self=',Tool.MainFilename,' ',dbgs(Node.StartPos));
 
3313
  if CompareItem.Node<>nil then
 
3314
    DbgOut(' Other=',CompareItem.Tool.MainFilename,' ',dbgs(CompareItem.Node.StartPos));
 
3315
  debugln('');}
 
3316
  Result:=CompareTextIgnoringSpace(ParamTypeList,CompareItem.ParamTypeList,false);
 
3317
end;
 
3318
 
 
3319
function TIdentifierListItem.CompareParamList(
 
3320
  CompareItem: TIdentifierListSearchItem): integer;
 
3321
begin
 
3322
  if (ParamTypeList='') and (CompareItem.ParamList='') then
 
3323
    exit(0);
 
3324
  Result:=CompareTextIgnoringSpace(ParamTypeList,CompareItem.ParamList,false);
 
3325
end;
 
3326
 
 
3327
function TIdentifierListItem.CalcMemSize: PtrUInt;
 
3328
begin
 
3329
  Result:=PtrUInt(InstanceSize)
 
3330
    +MemSizeString(FParamTypeList)
 
3331
    +MemSizeString(FNodeHash)
 
3332
    +MemSizeString(Identifier);
 
3333
end;
 
3334
 
 
3335
{ TIdentifierHistoryList }
 
3336
 
 
3337
procedure TIdentifierHistoryList.SetCapacity(const AValue: integer);
 
3338
begin
 
3339
  if FCapacity=AValue then exit;
 
3340
  FCapacity:=AValue;
 
3341
  if FCapacity<1 then FCapacity:=1;
 
3342
  while (FItems.Count>0) and (FItems.Count>=FCapacity) do
 
3343
    FItems.FreeAndDelete(FItems.FindHighest);
 
3344
end;
 
3345
 
 
3346
function TIdentifierHistoryList.FindItem(NewItem: TIdentifierListItem
 
3347
  ): TAVLTreeNode;
 
3348
begin
 
3349
  if NewItem<>nil then
 
3350
    Result:=FItems.FindKey(NewItem,@CompareIdentItemWithHistListItem)
 
3351
  else
 
3352
    Result:=nil;
 
3353
end;
 
3354
 
 
3355
constructor TIdentifierHistoryList.Create;
 
3356
begin
 
3357
  FItems:=TAVLTree.Create(@CompareIdentHistListItem);
 
3358
  FCapacity:=30;
 
3359
end;
 
3360
 
 
3361
destructor TIdentifierHistoryList.Destroy;
 
3362
begin
 
3363
  Clear;
 
3364
  FItems.Free;
 
3365
  inherited Destroy;
 
3366
end;
 
3367
 
 
3368
procedure TIdentifierHistoryList.Clear;
 
3369
begin
 
3370
  FItems.FreeAndClear;
 
3371
end;
 
3372
 
 
3373
procedure TIdentifierHistoryList.Add(NewItem: TIdentifierListItem);
 
3374
var
 
3375
  OldAVLNode: TAVLTreeNode;
 
3376
  NewHistItem: TIdentHistListItem;
 
3377
  AnAVLNode: TAVLTreeNode;
 
3378
  AdjustIndex: Integer;
 
3379
  AnHistItem: TIdentHistListItem;
 
3380
begin
 
3381
  if NewItem=nil then exit;
 
3382
  OldAVLNode:=FindItem(NewItem);
 
3383
  {$IFDEF ShowHistory}
 
3384
  DebugLn('TIdentifierHistoryList.Add Count=',Count,' Found=',OldAVLNode<>nil,
 
3385
    ' ITEM: ',NewItem.AsString);
 
3386
  {$ENDIF}
 
3387
  if OldAVLNode<>nil then begin
 
3388
    // already in tree
 
3389
    NewHistItem:=TIdentHistListItem(OldAVLNode.Data);
 
3390
    if NewHistItem.HistoryIndex=0 then exit;
 
3391
    // must be moved -> remove it from the tree
 
3392
    AdjustIndex:=NewHistItem.HistoryIndex;
 
3393
    FItems.Delete(OldAVLNode);
 
3394
  end else begin
 
3395
    // create a new history item
 
3396
    NewHistItem:=TIdentHistListItem.Create;
 
3397
    NewHistItem.Identifier:=NewItem.Identifier;
 
3398
    NewHistItem.NodeDesc:=NewItem.GetDesc;
 
3399
    NewHistItem.ParamList:=NewItem.ParamTypeList;
 
3400
    AdjustIndex:=0;
 
3401
  end;
 
3402
  NewHistItem.HistoryIndex:=0;
 
3403
  // adjust all other HistoryIndex
 
3404
  AnAVLNode:=Fitems.FindLowest;
 
3405
  while AnAVLNode<>nil do begin
 
3406
    AnHistItem:=TIdentHistListItem(AnAVLNode.Data);
 
3407
    if AnHistItem.HistoryIndex>=AdjustIndex then
 
3408
      inc(AnHistItem.HistoryIndex);
 
3409
    AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
 
3410
  end;
 
3411
  if (FItems.Count>0) and (FItems.Count>=FCapacity) then
 
3412
    FItems.FreeAndDelete(FItems.FindHighest);
 
3413
  FItems.Add(NewHistItem);
 
3414
  {$IFDEF ShowHistory}
 
3415
  DebugLn('TIdentifierHistoryList.Added Count=',Count);
 
3416
  {$ENDIF}
 
3417
end;
 
3418
 
 
3419
function TIdentifierHistoryList.GetHistoryIndex(AnItem: TIdentifierListItem
 
3420
  ): integer;
 
3421
var
 
3422
  AnAVLNode: TAVLTreeNode;
 
3423
begin
 
3424
  AnAVLNode:=FindItem(AnItem);
 
3425
  if AnAVLNode=nil then
 
3426
    Result:=33333333  // a very high value
 
3427
  else
 
3428
    Result:=TIdentHistListItem(AnAVLNode.Data).HistoryIndex;
 
3429
end;
 
3430
 
 
3431
function TIdentifierHistoryList.Count: integer;
 
3432
begin
 
3433
  Result:=FItems.Count;
 
3434
end;
 
3435
 
 
3436
function TIdentifierHistoryList.CalcMemSize: PtrUInt;
 
3437
var
 
3438
  Node: TAVLTreeNode;
 
3439
  Item: TIdentHistListItem;
 
3440
begin
 
3441
  Result:=PtrUInt(InstanceSize);
 
3442
  if FItems<>nil then begin
 
3443
    inc(Result,FItems.Count*SizeOf(TAVLTreeNode));
 
3444
    Node:=FItems.FindLowest;
 
3445
    while Node<>nil do begin
 
3446
      Item:=TIdentHistListItem(Node.Data);
 
3447
      inc(Result,Item.CalcMemSize);
 
3448
      Node:=FItems.FindSuccessor(Node);
 
3449
    end;
 
3450
  end;
 
3451
end;
 
3452
 
 
3453
{ TCodeContextInfo }
 
3454
 
 
3455
function TCodeContextInfo.GetItems(Index: integer): TCodeContextInfoItem;
 
3456
begin
 
3457
  Result:=TCodeContextInfoItem(FItems[Index]);
 
3458
end;
 
3459
 
 
3460
constructor TCodeContextInfo.Create;
 
3461
begin
 
3462
  FItems:=TFPList.Create;
 
3463
end;
 
3464
 
 
3465
destructor TCodeContextInfo.Destroy;
 
3466
begin
 
3467
  Clear;
 
3468
  FreeAndNil(FItems);
 
3469
  inherited Destroy;
 
3470
end;
 
3471
 
 
3472
function TCodeContextInfo.Count: integer;
 
3473
begin
 
3474
  Result:=FItems.Count;
 
3475
end;
 
3476
 
 
3477
function TCodeContextInfo.Add(const Context: TExpressionType): integer;
 
3478
var
 
3479
  Item: TCodeContextInfoItem;
 
3480
begin
 
3481
  Item:=TCodeContextInfoItem.Create;
 
3482
  Item.Expr:=Context;
 
3483
  Result:=FItems.Add(Item);
 
3484
end;
 
3485
 
 
3486
function TCodeContextInfo.AddCompilerProc: integer;
 
3487
var
 
3488
  Item: TCodeContextInfoItem;
 
3489
begin
 
3490
  Item:=TCodeContextInfoItem.Create;
 
3491
  Result:=FItems.Add(Item);
 
3492
end;
 
3493
 
 
3494
procedure TCodeContextInfo.Clear;
 
3495
var
 
3496
  i: Integer;
 
3497
begin
 
3498
  for i:=0 to FItems.Count-1 do
 
3499
    TObject(FItems[i]).Free;
 
3500
  FItems.Clear;
 
3501
end;
 
3502
 
 
3503
function TCodeContextInfo.CalcMemSize: PtrUInt;
 
3504
begin
 
3505
  Result:=PtrUInt(InstanceSize)
 
3506
    +PtrUInt(TCodeContextInfoItem)*SizeOf(FItems.Count)
 
3507
    +MemSizeString(FProcName);
 
3508
end;
 
3509
 
 
3510
{ TIdentifierListSearchItem }
 
3511
 
 
3512
function TIdentifierListSearchItem.CalcMemSize: PtrUInt;
 
3513
begin
 
3514
  Result:=PtrUInt(InstanceSize)
 
3515
    +MemSizeString(ParamList);
 
3516
end;
 
3517
 
 
3518
{ TIdentHistListItem }
 
3519
 
 
3520
function TIdentHistListItem.CalcMemSize: PtrUInt;
 
3521
begin
 
3522
  Result:=PtrUInt(InstanceSize)
 
3523
    +MemSizeString(Identifier)
 
3524
    +MemSizeString(ParamList);
 
3525
end;
 
3526
 
 
3527
{ TCodeContextInfoItem }
 
3528
 
 
3529
destructor TCodeContextInfoItem.Destroy;
 
3530
begin
 
3531
  FreeAndNil(Params);
 
3532
  inherited Destroy;
 
3533
end;
 
3534
 
 
3535
end.
 
3536