mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 09:04:11 +01:00
4256 lines
145 KiB
ObjectPascal
4256 lines
145 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
TIdentCompletionTool enhances the TFindDeclarationTool with the ability
|
|
to create lists of valid identifiers at a specific code position.
|
|
}
|
|
unit IdentCompletionTool;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
// activate for debug:
|
|
|
|
// mem check
|
|
{ $DEFINE MEM_CHECK}
|
|
|
|
// verbosity
|
|
{ $DEFINE CTDEBUG}
|
|
{ $DEFINE ShowFoundIdents}
|
|
{ $DEFINE ShowFilteredIdents}
|
|
{ $DEFINE ShowHistory}
|
|
{ $DEFINE VerboseCodeContext}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, typinfo, FileProcs, LazFileUtils,
|
|
CodeTree, CodeAtom, CodeCache, CustomCodeTool, CodeToolsStrConsts,
|
|
KeywordFuncLists, BasicCodeTools, LinkScanner, AvgLvlTree, AVL_Tree,
|
|
SourceChanger, FindDeclarationTool, PascalReaderTool, PascalParserTool,
|
|
CodeToolsStructs, ExprEval, LazDbgLog, crc;
|
|
|
|
type
|
|
TIdentCompletionTool = class;
|
|
TIdentifierHistoryList = class;
|
|
|
|
//----------------------------------------------------------------------------
|
|
// gathered identifier list
|
|
|
|
TIdentifierCompatibility = (
|
|
icompExact,
|
|
icompCompatible,
|
|
icompUnknown,
|
|
icompIncompatible
|
|
);
|
|
TIdentifierCompatibilities = set of TIdentifierCompatibility;
|
|
|
|
TIdentListItemFlag = (
|
|
iliHasChilds,
|
|
iliBaseExprTypeValid,
|
|
iliIsFunction,
|
|
iliIsFunctionValid,
|
|
iliIsAbstractMethod,
|
|
iliIsAbstractMethodValid,
|
|
iliParamTypeListValid,
|
|
iliParamNameListValid,
|
|
iliNodeValid,
|
|
iliNodeHashValid,
|
|
iliNodeGoneWarned,
|
|
iliIsConstructor,
|
|
iliIsConstructorValid,
|
|
iliIsDestructor,
|
|
iliIsDestructorValid,
|
|
iliKeyword,
|
|
iliResultTypeValid,
|
|
iliHasIndexValid,
|
|
iliHasIndex,
|
|
iliHasParamListValid,
|
|
iliHasParamList,
|
|
iliIsReadOnlyValid,
|
|
iliIsReadOnly,
|
|
iliHintModifiersValid,
|
|
iliIsDeprecated,
|
|
iliIsPlatform,
|
|
iliIsExperimental,
|
|
iliIsUnimplemented,
|
|
iliIsLibrary,
|
|
iliAtCursor, // the item is the identifier at the completion
|
|
iliNeedsAmpersand, //the item has to be prefixed with '&'
|
|
iliHasLowerVisibility
|
|
);
|
|
TIdentListItemFlags = set of TIdentListItemFlag;
|
|
|
|
{ TIdentifierListSearchItem }
|
|
|
|
TIdentifierListSearchItem = class
|
|
public
|
|
Identifier: PChar;
|
|
ParamList: string;
|
|
function CalcMemSize: PtrUInt;
|
|
end;
|
|
|
|
TIdentifierList = class;
|
|
|
|
{ TIdentifierListItem }
|
|
|
|
TIdentifierListItem = class
|
|
private
|
|
FParamTypeList: string;
|
|
FParamNameList: string;
|
|
FNode: TCodeTreeNode;
|
|
FResultType: string;
|
|
FToolNodesDeletedStep: integer;// only valid if iliNodeValid
|
|
FNodeStartPos: integer;
|
|
FNodeDesc: TCodeTreeNodeDesc;
|
|
FNodeHash: Cardinal;
|
|
function GetNode: TCodeTreeNode;
|
|
function GetParamTypeList: string;
|
|
function GetParamNameList: string;
|
|
procedure SetNode(const AValue: TCodeTreeNode);
|
|
procedure SetParamTypeList(const AValue: string);
|
|
procedure SetParamNameList(const AValue: string);
|
|
procedure SetResultType(const AValue: string);
|
|
public
|
|
Compatibility: TIdentifierCompatibility;
|
|
HistoryIndex: integer;
|
|
Identifier: string;
|
|
Level: integer;
|
|
Tool: TFindDeclarationTool;
|
|
DefaultDesc: TCodeTreeNodeDesc;
|
|
Flags: TIdentListItemFlags;
|
|
BaseExprType: TExpressionType;
|
|
function AsString: string;
|
|
procedure BeautifyIdentifier({%H-}IdentList: TIdentifierList); virtual;
|
|
function GetDesc: TCodeTreeNodeDesc;
|
|
constructor Create(NewCompatibility: TIdentifierCompatibility;
|
|
NewHasChilds: boolean; NewHistoryIndex: integer;
|
|
NewIdentifier: PChar; NewLevel: integer;
|
|
NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
|
|
NewDefaultDesc: TCodeTreeNodeDesc);
|
|
function IsProcNodeWithParams: boolean;
|
|
function IsPropertyWithParams: boolean;
|
|
function IsPropertyReadOnly: boolean;
|
|
function GetHintModifiers: TPascalHintModifiers;
|
|
function CheckHasChilds: boolean;
|
|
function CanBeAssigned: boolean;
|
|
procedure UpdateBaseContext;
|
|
function HasChilds: boolean;
|
|
function HasIndex: boolean;
|
|
function IsFunction: boolean;
|
|
function IsConstructor: boolean;
|
|
function IsDestructor: boolean;
|
|
function IsAbstractMethod: boolean;
|
|
function TryIsAbstractMethod: boolean;
|
|
procedure Clear;
|
|
procedure UnbindNode;
|
|
procedure StoreNodeHash;
|
|
function RestoreNode: boolean;
|
|
function GetNodeHash(ANode: TCodeTreeNode): Cardinal;
|
|
function CompareParamList(CompareItem: TIdentifierListItem): integer;
|
|
function CompareParamList(CompareItem: TIdentifierListSearchItem): integer;
|
|
function CalcMemSize: PtrUInt; virtual;
|
|
public
|
|
property ParamTypeList: string read GetParamTypeList write SetParamTypeList;
|
|
property ParamNameList: string read GetParamNameList write SetParamNameList;
|
|
property ResultType: string read FResultType write SetResultType;
|
|
property Node: TCodeTreeNode read GetNode write SetNode;
|
|
end;
|
|
TIdentifierListItemClass = class of TIdentifierListItem;
|
|
|
|
TUnitNameSpaceIdentifierListItem = class(TIdentifierListItem)
|
|
public
|
|
FileUnitName: string;
|
|
IdentifierStartInUnitName: Integer;
|
|
|
|
constructor Create(NewCompatibility: TIdentifierCompatibility;
|
|
NewHasChilds: boolean; NewHistoryIndex: integer;
|
|
NewIdentifier: PChar; NewLevel: integer;
|
|
NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
|
|
NewDefaultDesc: TCodeTreeNodeDesc;
|
|
NewFileUnitName: PChar;
|
|
NewIdentifierStartInUnitName: Integer);
|
|
function CalcMemSize: PtrUInt; override;
|
|
end;
|
|
TUnitNameSpaceIdentifierListItemClass = class of TUnitNameSpaceIdentifierListItem;
|
|
|
|
TIdentifierListFlag = (
|
|
ilfFilteredListNeedsUpdate,
|
|
ilfUsedToolsNeedsUpdate
|
|
);
|
|
TIdentifierListFlags = set of TIdentifierListFlag;
|
|
|
|
TIdentifierListContextFlag = (
|
|
ilcfStartInStatement, // context starts in statements. e.g. between begin..end
|
|
ilcfStartOfStatement, // atom is start of statement. e.g. 'A|:=' or 'A|;', does not check if A can be assigned
|
|
ilcfStartOfOperand, // atom is start of an operand. e.g. 'A|.B'
|
|
ilcfStartIsSubIdent, // atom in front is point
|
|
ilcfNeedsEndSemicolon, // after context a semicolon is needed. e.g. 'A| end'
|
|
ilcfNoEndSemicolon, // no semicolon after. E.g. 'A| else'
|
|
ilcfNeedsEndComma, // after context a comma is needed. e.g. 'uses sysutil| classes'
|
|
ilcfNeedsDo, // after context a 'do' is needed. e.g. 'with Form1| do'
|
|
ilcfIsExpression, // is expression part of statement. e.g. 'if expr'
|
|
ilcfCanProcDeclaration,// context allows one to declare a procedure/method
|
|
ilcfEndOfLine, // atom at end of line
|
|
ilcfDontAllowProcedures// context doesn't allow procedures (e.g. in function parameter, after other operator, in if codition etc. - Delphi mode supports assignment of procedures!)
|
|
);
|
|
TIdentifierListContextFlags = set of TIdentifierListContextFlag;
|
|
|
|
TIdentifierList = class
|
|
private
|
|
FContext: TFindContext;
|
|
FNewMemberVisibility: TCodeTreeNodeDesc;
|
|
FContextFlags: TIdentifierListContextFlags;
|
|
FSortForHistory: boolean;
|
|
FSortForScope: boolean;
|
|
FStartAtom: TAtomPosition;
|
|
FStartAtomBehind: TAtomPosition;
|
|
FStartAtomInFront: TAtomPosition;
|
|
FStartBracketLvl: integer;
|
|
FStartContextPos: TCodeXYPosition;
|
|
FCreatedIdentifiers: TFPList; // list of PChar
|
|
FFilteredList: TFPList; // list of TIdentifierListItem
|
|
FFlags: TIdentifierListFlags;
|
|
FHistory: TIdentifierHistoryList;
|
|
FItems: TAvgLvlTree; // tree of TIdentifierListItem (completely sorted)
|
|
FIdentView: TAVLTree; // tree of TIdentifierListItem sorted for identifiers
|
|
FUsedTools: TAVLTree; // tree of TFindDeclarationTool
|
|
FIdentSearchItem: TIdentifierListSearchItem;
|
|
FPrefix: string;
|
|
FStartContext: TFindContext;
|
|
function CompareIdentListItems({%H-}Tree: TAvgLvlTree; Data1, Data2: Pointer): integer;
|
|
procedure SetHistory(const AValue: TIdentifierHistoryList);
|
|
procedure SetSortForHistory(AValue: boolean);
|
|
procedure SetSortForScope(AValue: boolean);
|
|
procedure UpdateFilteredList;
|
|
function GetFilteredItems(Index: integer): TIdentifierListItem;
|
|
procedure SetPrefix(const AValue: string);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Add(NewItem: TIdentifierListItem);
|
|
function Count: integer;
|
|
function GetFilteredCount: integer;
|
|
function HasIdentifier(Identifier: PChar; const ParamList: string): boolean;
|
|
function FindIdentifier(Identifier: PChar; const ParamList: string): TIdentifierListItem;
|
|
function FindIdentifier(Identifier: PChar; PreferProc: boolean): TIdentifierListItem;
|
|
function FindCreatedIdentifier(const Ident: string): integer;
|
|
function CreateIdentifier(const Ident: string): PChar;
|
|
function StartUpAtomInFrontIs(const s: string): boolean;
|
|
function StartUpAtomBehindIs(const s: string): boolean;
|
|
function CompletePrefix(const OldPrefix: string): string;
|
|
function CalcMemSize: PtrUInt;
|
|
public
|
|
property Context: TFindContext read FContext write FContext;
|
|
property ContextFlags: TIdentifierListContextFlags
|
|
read FContextFlags write FContextFlags;
|
|
property NewMemberVisibility: TCodeTreeNodeDesc // identifier is a class member, e.g. a variable or a procedure name
|
|
read FNewMemberVisibility write FNewMemberVisibility;
|
|
property FilteredItems[Index: integer]: TIdentifierListItem
|
|
read GetFilteredItems;
|
|
property History: TIdentifierHistoryList read FHistory write SetHistory;
|
|
property Prefix: string read FPrefix write SetPrefix;
|
|
property SortForHistory: boolean read FSortForHistory write SetSortForHistory;
|
|
property SortForScope: boolean read FSortForScope write SetSortForScope;
|
|
property StartAtom: TAtomPosition read FStartAtom write FStartAtom;
|
|
property StartAtomInFront: TAtomPosition
|
|
read FStartAtomInFront write FStartAtomInFront; // in front of variable, not only of identifier
|
|
property StartAtomBehind: TAtomPosition
|
|
read FStartAtomBehind write FStartAtomBehind; // directly behind
|
|
property StartBracketLvl: integer
|
|
read FStartBracketLvl write FStartBracketLvl;
|
|
property StartContext: TFindContext read FStartContext write FStartContext;
|
|
property StartContextPos: TCodeXYPosition
|
|
read FStartContextPos write FStartContextPos;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------
|
|
// history list
|
|
|
|
{ TIdentHistListItem }
|
|
|
|
TIdentHistListItem = class
|
|
public
|
|
Identifier: string;
|
|
NodeDesc: TCodeTreeNodeDesc;
|
|
ParamList: string;
|
|
HistoryIndex: integer;
|
|
function CalcMemSize: PtrUInt;
|
|
end;
|
|
|
|
{ TIdentifierHistoryList }
|
|
|
|
TIdentifierHistoryList = class
|
|
private
|
|
FCapacity: integer;
|
|
FItems: TAVLTree; // tree of TIdentHistListItem
|
|
procedure SetCapacity(const AValue: integer);
|
|
function FindItem(NewItem: TIdentifierListItem): TAVLTreeNode;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure Add(NewItem: TIdentifierListItem);
|
|
function GetHistoryIndex(AnItem: TIdentifierListItem): integer;
|
|
function Count: integer;
|
|
function CalcMemSize: PtrUInt;
|
|
public
|
|
property Capacity: integer read FCapacity write SetCapacity;
|
|
end;
|
|
|
|
|
|
//----------------------------------------------------------------------------
|
|
|
|
{ TCodeContextInfoItem }
|
|
|
|
TCodeContextInfoItem = class
|
|
public
|
|
Expr: TExpressionType;
|
|
// compiler predefined proc
|
|
ProcName: string;
|
|
Params: TStringList;
|
|
ResultType: string;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TCodeContextInfo }
|
|
|
|
TCodeContextInfo = class
|
|
private
|
|
FEndPos: integer;
|
|
FItems: TFPList; // list of TCodeContextInfoItem
|
|
FParameterIndex: integer;
|
|
FProcName: string;
|
|
FProcNameAtom: TAtomPosition;
|
|
FStartPos: integer;
|
|
FTool: TFindDeclarationTool;
|
|
function GetItems(Index: integer): TCodeContextInfoItem;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Count: integer;
|
|
property Items[Index: integer]: TCodeContextInfoItem read GetItems; default;
|
|
function Add(const Context: TExpressionType): integer;
|
|
function AddCompilerProc: integer;
|
|
procedure Clear;
|
|
property Tool: TFindDeclarationTool read FTool write FTool;
|
|
property ParameterIndex: integer read FParameterIndex write FParameterIndex;// 1 based
|
|
property ProcName: string read FProcName write FProcName;
|
|
property ProcNameAtom: TAtomPosition read FProcNameAtom write FProcNameAtom;
|
|
property StartPos: integer read FStartPos write FStartPos;// context is valid from StartPos to EndPos
|
|
property EndPos: integer read FEndPos write FEndPos;
|
|
|
|
function CalcMemSize: PtrUInt;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------
|
|
// TIdentCompletionTool
|
|
|
|
TIdentCompletionTool = class(TFindDeclarationTool)
|
|
private
|
|
FBeautifier: TBeautifyCodeOptions;
|
|
FLastGatheredIdentParent: TCodeTreeNode;
|
|
FLastGatheredIdentLevel: integer;
|
|
FICTClassAndAncestorsAndExtClassOfHelper: TFPList;// list of PCodeXYPosition
|
|
FIDCTFoundPublicProperties: TAVLTree;// tree of PChar (pointing to the
|
|
// property names in source)
|
|
FIDTFoundMethods: TAVLTree;// tree of TCodeTreeNodeExtension Txt=clean text
|
|
FIDTTreeOfUnitFiles: TAVLTree;// tree of TUnitFileInfo
|
|
FIDTTreeOfUnitFiles_NamespacePath: string;
|
|
FIDTTreeOfUnitFiles_CaseInsensitive: Boolean;
|
|
FIDTTreeOfNamespaces: TAVLTree;// tree of TNameSpaceInfo
|
|
procedure AddToTreeOfUnitFileInfo(const AFilename: string);
|
|
procedure AddBaseConstant(const BaseName: PChar);
|
|
procedure AddBaseType(const BaseName: PChar);
|
|
procedure AddCompilerFunction(const AProcName, AParameterList,
|
|
AResultType: PChar);
|
|
procedure AddCompilerProcedure(const AProcName, AParameterList: PChar);
|
|
procedure AddKeyWord(aKeyWord: string);
|
|
protected
|
|
CurrentIdentifierList: TIdentifierList;
|
|
CurrentIdentifierContexts: TCodeContextInfo;
|
|
function CollectAllIdentifiers(Params: TFindDeclarationParams;
|
|
const FoundContext: TFindContext): TIdentifierFoundResult;
|
|
procedure GatherPredefinedIdentifiers(CleanPos: integer;
|
|
const Context, GatherContext: TFindContext);
|
|
procedure GatherUsefulIdentifiers(CleanPos: integer;
|
|
const Context, GatherContext: TFindContext);
|
|
procedure GatherUnitnames(const NameSpacePath: string = '');
|
|
procedure GatherSourceNames(const Context: TFindContext);
|
|
procedure GatherContextKeywords(const Context: TFindContext;
|
|
CleanPos: integer; BeautifyCodeOptions: TBeautifyCodeOptions);
|
|
procedure InitCollectIdentifiers(const CursorPos: TCodeXYPosition;
|
|
var IdentifierList: TIdentifierList);
|
|
procedure ParseSourceTillCollectionStart(const CursorPos: TCodeXYPosition;
|
|
out CleanCursorPos: integer; out CursorNode: TCodeTreeNode;
|
|
out IdentStartPos, IdentEndPos: integer);
|
|
function FindIdentifierStartPos(const CursorPos: TCodeXYPosition
|
|
): TCodeXYPosition;
|
|
procedure FindCollectionContext(Params: TFindDeclarationParams;
|
|
IdentStartPos: integer; CursorNode: TCodeTreeNode;
|
|
out ExprType: TExpressionType; out ContextExprStartPos: LongInt;
|
|
out StartInSubContext, HasInheritedKeyword: Boolean);
|
|
function CollectAllContexts(Params: TFindDeclarationParams;
|
|
const FoundContext: TFindContext): TIdentifierFoundResult;
|
|
procedure AddCollectionContext(Tool: TFindDeclarationTool;
|
|
Node: TCodeTreeNode);
|
|
function CheckCursorInCompilerDirective(CursorPos: TCodeXYPosition): boolean;
|
|
procedure AddCompilerDirectiveMacros(Directive: string);
|
|
public
|
|
function GatherAvailableUnitNames(const CursorPos: TCodeXYPosition;
|
|
var IdentifierList: TIdentifierList): Boolean;
|
|
function GatherIdentifiers(const CursorPos: TCodeXYPosition;
|
|
var IdentifierList: TIdentifierList): boolean;
|
|
function FindCodeContext(const CursorPos: TCodeXYPosition;
|
|
out CodeContexts: TCodeContextInfo): boolean;
|
|
function FindAbstractMethods(const CursorPos: TCodeXYPosition;
|
|
out ListOfPCodeXYPosition: TFPList;
|
|
SkipAbstractsInStartClass: boolean = false): boolean;
|
|
function GetValuesOfCaseVariable(const CursorPos: TCodeXYPosition;
|
|
List: TStrings): boolean;
|
|
property Beautifier: TBeautifyCodeOptions read FBeautifier write FBeautifier;
|
|
|
|
procedure CalcMemSize(Stats: TCTMemStats); override;
|
|
end;
|
|
|
|
function dbgs(Flag: TIdentifierListContextFlag): string; overload;
|
|
function dbgs(Flags: TIdentifierListContextFlags): string; overload;
|
|
|
|
var
|
|
CIdentifierListItem: TIdentifierListItemClass = TIdentifierListItem;
|
|
CUnitNameSpaceIdentifierListItem: TUnitNameSpaceIdentifierListItemClass = TUnitNameSpaceIdentifierListItem;
|
|
|
|
implementation
|
|
|
|
const
|
|
CompilerFuncHistoryIndex = 10;
|
|
CompilerFuncLevel = 10;
|
|
|
|
function CompareIdentListItemsForIdents(Data1, Data2: Pointer): integer;
|
|
var
|
|
Item1: TIdentifierListItem absolute Data1;
|
|
Item2: TIdentifierListItem absolute Data2;
|
|
begin
|
|
// sort alpabetically (lower is better)
|
|
Result:=CompareIdentifierPtrs(Pointer(Item2.Identifier),Pointer(Item1.Identifier));
|
|
if Result<>0 then exit;
|
|
|
|
// then sort for ParamList (lower is better)
|
|
Result:=Item2.CompareParamList(Item1);
|
|
end;
|
|
|
|
function CompareIdentListSearchWithItems(SearchItem, Item: Pointer): integer;
|
|
var
|
|
TheSearchItem: TIdentifierListSearchItem absolute SearchItem;
|
|
TheItem: TIdentifierListItem absolute Item;
|
|
begin
|
|
// sort alpabetically (lower is better)
|
|
Result:=CompareIdentifierPtrs(Pointer(TheItem.Identifier),TheSearchItem.Identifier);
|
|
if Result<>0 then exit;
|
|
|
|
// then sort for ParamList (lower is better)
|
|
Result:=TheItem.CompareParamList(TheSearchItem);
|
|
end;
|
|
|
|
function CompareIdentListSearchWithItemsWithoutParams(SearchItem, Item: Pointer): integer;
|
|
var
|
|
TheSearchItem: TIdentifierListSearchItem absolute SearchItem;
|
|
TheItem: TIdentifierListItem absolute Item;
|
|
begin
|
|
// sort alpabetically (lower is better)
|
|
Result:=CompareIdentifierPtrs(Pointer(TheItem.Identifier),TheSearchItem.Identifier);
|
|
end;
|
|
|
|
function CompareIdentHistListItem(Data1, Data2: Pointer): integer;
|
|
var
|
|
Item1: TIdentHistListItem absolute Data1;
|
|
Item2: TIdentHistListItem absolute Data2;
|
|
begin
|
|
Result:=CompareIdentifiers(PChar(Pointer(Item2.Identifier)),
|
|
PChar(Pointer(Item1.Identifier)));
|
|
if Result<>0 then exit;
|
|
|
|
//debugln('CompareIdentHistListItem ',Item2.Identifier,'=',Item1.Identifier);
|
|
Result:=CompareIdentifiers(PChar(Pointer(Item2.ParamList)),
|
|
PChar(Pointer(Item1.ParamList)));
|
|
end;
|
|
|
|
function CompareIdentItemWithHistListItem(Data1, Data2: Pointer): integer;
|
|
var
|
|
IdentItem: TIdentifierListItem absolute Data1;
|
|
HistItem: TIdentHistListItem absolute Data2;
|
|
begin
|
|
Result:=CompareIdentifierPtrs(Pointer(HistItem.Identifier),
|
|
Pointer(IdentItem.Identifier));
|
|
if Result<>0 then exit;
|
|
|
|
//debugln('CompareIdentItemWithHistListItem ',HistItem.Identifier,'=',GetIdentifier(IdentItem.Identifier));
|
|
Result:=SysUtils.CompareText(HistItem.ParamList,IdentItem.ParamTypeList);
|
|
end;
|
|
|
|
function dbgs(Flag: TIdentifierListContextFlag): string;
|
|
begin
|
|
Result:=GetEnumName(typeinfo(Flag),ord(Flag));
|
|
end;
|
|
|
|
function dbgs(Flags: TIdentifierListContextFlags): string;
|
|
var
|
|
f: TIdentifierListContextFlag;
|
|
begin
|
|
Result:='';
|
|
for f:=Low(TIdentifierListContextFlag) to High(TIdentifierListContextFlag) do
|
|
if f in Flags then begin
|
|
if Result<>'' then Result+=',';
|
|
Result+=dbgs(f);
|
|
end;
|
|
Result:='['+Result+']';
|
|
end;
|
|
|
|
{ TUnitNameSpaceIdentifierListItem }
|
|
|
|
constructor TUnitNameSpaceIdentifierListItem.Create(
|
|
NewCompatibility: TIdentifierCompatibility; NewHasChilds: boolean;
|
|
NewHistoryIndex: integer; NewIdentifier: PChar; NewLevel: integer;
|
|
NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
|
|
NewDefaultDesc: TCodeTreeNodeDesc; NewFileUnitName: PChar;
|
|
NewIdentifierStartInUnitName: Integer);
|
|
begin
|
|
inherited Create(NewCompatibility, NewHasChilds, NewHistoryIndex,
|
|
NewIdentifier, NewLevel, NewNode, NewTool, NewDefaultDesc);
|
|
FileUnitName := NewFileUnitName;
|
|
IdentifierStartInUnitName := NewIdentifierStartInUnitName;
|
|
end;
|
|
|
|
function TUnitNameSpaceIdentifierListItem.CalcMemSize: PtrUInt;
|
|
begin
|
|
Result := inherited CalcMemSize
|
|
+MemSizeString(FileUnitName);
|
|
end;
|
|
|
|
{ TIdentifierList }
|
|
|
|
function TIdentifierList.CompareIdentListItems(Tree: TAvgLvlTree; Data1,
|
|
Data2: Pointer): integer;
|
|
var
|
|
Item1: TIdentifierListItem absolute Data1;
|
|
Item2: TIdentifierListItem absolute Data2;
|
|
begin
|
|
if SortForScope then begin
|
|
// first sort for Compatibility (lower is better)
|
|
if ord(Item1.Compatibility)<ord(Item2.Compatibility) then begin
|
|
Result:=-1;
|
|
exit;
|
|
end else if ord(Item1.Compatibility)>ord(Item2.Compatibility) then begin
|
|
Result:=1;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if SortForHistory then begin
|
|
// then sort for History (lower is better)
|
|
if Item1.HistoryIndex<Item2.HistoryIndex then begin
|
|
Result:=-1;
|
|
exit;
|
|
end else if Item1.HistoryIndex>Item2.HistoryIndex then begin
|
|
Result:=1;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if SortForScope then begin
|
|
// then sort for Level (i.e. scope, lower is better)
|
|
if Item1.Level<Item2.Level then begin
|
|
Result:=-1;
|
|
exit;
|
|
end else if Item1.Level>Item2.Level then begin
|
|
Result:=1;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// then sort alpabetically (lower is better)
|
|
Result:=CompareIdentifierPtrs(Pointer(Item2.Identifier),Pointer(Item1.Identifier));
|
|
if Result<>0 then exit;
|
|
|
|
// then sort for ParamList (lower is better)
|
|
Result:=Item2.CompareParamList(Item1);
|
|
end;
|
|
|
|
procedure TIdentifierList.SetPrefix(const AValue: string);
|
|
begin
|
|
if FPrefix=AValue then exit;
|
|
FPrefix:=AValue;
|
|
Include(FFlags,ilfFilteredListNeedsUpdate);
|
|
end;
|
|
|
|
procedure TIdentifierList.UpdateFilteredList;
|
|
var
|
|
AnAVLNode: TAvgLvlTreeNode;
|
|
CurItem: TIdentifierListItem;
|
|
begin
|
|
if not (ilfFilteredListNeedsUpdate in FFlags) then exit;
|
|
if FFilteredList=nil then FFilteredList:=TFPList.Create;
|
|
FFilteredList.Count:=0;
|
|
FFilteredList.Capacity:=FItems.Count;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TIdentifierList.UpdateFilteredList Prefix="',Prefix,'"']);
|
|
{$ENDIF}
|
|
AnAVLNode:=FItems.FindLowest;
|
|
while AnAVLNode<>nil do begin
|
|
CurItem:=TIdentifierListItem(AnAVLNode.Data);
|
|
if (CurItem.Identifier<>'')
|
|
and ComparePrefixIdent(PChar(Pointer(Prefix)),PChar(Pointer(CurItem.Identifier)))
|
|
then begin
|
|
{$IFDEF ShowFilteredIdents}
|
|
DebugLn(['::: FILTERED ITEM ',FFilteredList.Count,' ',CurItem.Identifier]);
|
|
{$ENDIF}
|
|
if (length(Prefix)=length(CurItem.Identifier))
|
|
and (not (iliAtCursor in CurItem.Flags)) then
|
|
// put exact matches at the beginning
|
|
FFilteredList.Insert(0,CurItem)
|
|
else
|
|
FFilteredList.Add(CurItem);
|
|
end;
|
|
AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TIdentifierList.UpdateFilteredList ',dbgs(FFilteredList.Count),' of ',dbgs(FItems.Count)]);
|
|
{$ENDIF}
|
|
Exclude(FFlags,ilfFilteredListNeedsUpdate);
|
|
end;
|
|
|
|
procedure TIdentifierList.SetHistory(const AValue: TIdentifierHistoryList);
|
|
begin
|
|
if FHistory=AValue then exit;
|
|
FHistory:=AValue;
|
|
end;
|
|
|
|
procedure TIdentifierList.SetSortForHistory(AValue: boolean);
|
|
begin
|
|
if FSortForHistory=AValue then Exit;
|
|
FSortForHistory:=AValue;
|
|
Clear;
|
|
end;
|
|
|
|
procedure TIdentifierList.SetSortForScope(AValue: boolean);
|
|
begin
|
|
if FSortForScope=AValue then Exit;
|
|
FSortForScope:=AValue;
|
|
Clear;
|
|
end;
|
|
|
|
function TIdentifierList.GetFilteredItems(Index: integer): TIdentifierListItem;
|
|
begin
|
|
UpdateFilteredList;
|
|
if (Index<0) or (Index>=FFilteredList.Count) then
|
|
Result:=nil
|
|
else
|
|
Result:=TIdentifierListItem(FFilteredList[Index]);
|
|
end;
|
|
|
|
constructor TIdentifierList.Create;
|
|
begin
|
|
FFlags:=[ilfFilteredListNeedsUpdate];
|
|
FItems:=TAvgLvlTree.CreateObjectCompare(@CompareIdentListItems);
|
|
FIdentView:=TAVLTree.Create(@CompareIdentListItemsForIdents);
|
|
FIdentSearchItem:=TIdentifierListSearchItem.Create;
|
|
FCreatedIdentifiers:=TFPList.Create;
|
|
FSortForHistory:=true;
|
|
FSortForScope:=true;
|
|
end;
|
|
|
|
destructor TIdentifierList.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(FUsedTools);
|
|
FreeAndNil(FItems);
|
|
FreeAndNil(FIdentView);
|
|
FreeAndNil(FFilteredList);
|
|
FreeAndNil(FIdentSearchItem);
|
|
FreeAndNil(FCreatedIdentifiers);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TIdentifierList.Clear;
|
|
var
|
|
i: Integer;
|
|
p: Pointer;
|
|
begin
|
|
fContextFlags:=[];
|
|
fContext:=CleanFindContext;
|
|
FNewMemberVisibility:=ctnNone;
|
|
FStartBracketLvl:=0;
|
|
fStartContext:=CleanFindContext;
|
|
fStartContextPos.Code:=nil;
|
|
fStartContextPos.X:=1;
|
|
fStartContextPos.Y:=1;
|
|
for i:=0 to FCreatedIdentifiers.Count-1 do begin
|
|
p:=FCreatedIdentifiers[i];
|
|
FreeMem(p);
|
|
end;
|
|
FCreatedIdentifiers.Clear;
|
|
FItems.FreeAndClear;
|
|
FIdentView.Clear;
|
|
if FUsedTools<>nil then
|
|
FUsedTools.Clear;
|
|
FFlags:=FFlags+[ilfFilteredListNeedsUpdate,ilfUsedToolsNeedsUpdate];
|
|
end;
|
|
|
|
procedure TIdentifierList.Add(NewItem: TIdentifierListItem);
|
|
var
|
|
AnAVLNode: TAVLTreeNode;
|
|
begin
|
|
if (ilcfDontAllowProcedures in ContextFlags) and (NewItem.GetDesc = ctnProcedure) and
|
|
not (NewItem.IsFunction or NewItem.IsConstructor)
|
|
then
|
|
begin
|
|
NewItem.Free;
|
|
Exit;
|
|
end;
|
|
|
|
AnAVLNode:=FIdentView.FindKey(NewItem,@CompareIdentListItemsForIdents);
|
|
if AnAVLNode=nil then begin
|
|
if History<>nil then
|
|
NewItem.HistoryIndex:=History.GetHistoryIndex(NewItem);
|
|
FItems.Add(NewItem);
|
|
FIdentView.Add(NewItem);
|
|
FFlags:=FFlags+[ilfFilteredListNeedsUpdate,ilfUsedToolsNeedsUpdate];
|
|
end else begin
|
|
// redefined identifier -> ignore
|
|
//DebugLn('TIdentifierList.Add redefined: ',NewItem.AsString);
|
|
NewItem.Free;
|
|
end;
|
|
end;
|
|
|
|
function TIdentifierList.Count: integer;
|
|
begin
|
|
Result:=FItems.Count;
|
|
end;
|
|
|
|
function TIdentifierList.GetFilteredCount: integer;
|
|
begin
|
|
UpdateFilteredList;
|
|
Result:=FFilteredList.Count;
|
|
end;
|
|
|
|
function TIdentifierList.HasIdentifier(Identifier: PChar;
|
|
const ParamList: string): boolean;
|
|
begin
|
|
FIdentSearchItem.Identifier:=Identifier;
|
|
FIdentSearchItem.ParamList:=ParamList;
|
|
Result:=FIdentView.FindKey(FIdentSearchItem,
|
|
@CompareIdentListSearchWithItems)<>nil;
|
|
end;
|
|
|
|
function TIdentifierList.FindIdentifier(Identifier: PChar;
|
|
const ParamList: string): TIdentifierListItem;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
FIdentSearchItem.Identifier:=Identifier;
|
|
FIdentSearchItem.ParamList:=ParamList;
|
|
AVLNode:=FIdentView.FindKey(FIdentSearchItem,@CompareIdentListSearchWithItems);
|
|
if AVLNode<>nil then
|
|
Result:=TIdentifierListItem(AVLNode.Data)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TIdentifierList.FindIdentifier(Identifier: PChar; PreferProc: boolean
|
|
): TIdentifierListItem;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
StartNode: TAVLTreeNode;
|
|
begin
|
|
Result:=nil;
|
|
FIdentSearchItem.Identifier:=Identifier;
|
|
// ignore ParamList (for checking function overloading)
|
|
StartNode:=FIdentView.FindKey(FIdentSearchItem,@CompareIdentListSearchWithItemsWithoutParams);
|
|
if StartNode=nil then exit;
|
|
// identifier found, check preference
|
|
if (TIdentifierListItem(StartNode.Data).GetDesc in [ctnProcedure,ctnProcedureHead])=PreferProc
|
|
then
|
|
exit(TIdentifierListItem(StartNode.Data));
|
|
|
|
// identifier is a (not) proc, find the same identifier that fits PreferProc
|
|
|
|
// search in next nodes
|
|
AVLNode:=StartNode;
|
|
repeat
|
|
AVLNode:=FIdentView.FindSuccessor(AVLNode);
|
|
if (AVLNode=nil)
|
|
or (CompareIdentifiers(Identifier,PChar(TIdentifierListItem(AVLNode.Data).Identifier))<>0)
|
|
then break;
|
|
if (TIdentifierListItem(AVLNode.Data).GetDesc in [ctnProcedure,ctnProcedureHead])=PreferProc
|
|
then
|
|
exit(TIdentifierListItem(AVLNode.Data));
|
|
until false;
|
|
// search in previous nodes
|
|
AVLNode:=StartNode;
|
|
repeat
|
|
AVLNode:=FIdentView.FindPrecessor(AVLNode);
|
|
if (AVLNode=nil)
|
|
or (CompareIdentifiers(Identifier,PChar(TIdentifierListItem(AVLNode.Data).Identifier))<>0)
|
|
then break;
|
|
if (TIdentifierListItem(AVLNode.Data).GetDesc in [ctnProcedure,ctnProcedureHead])=PreferProc
|
|
then
|
|
exit(TIdentifierListItem(AVLNode.Data));
|
|
until false;
|
|
end;
|
|
|
|
function TIdentifierList.FindCreatedIdentifier(const Ident: string): integer;
|
|
begin
|
|
if Ident<>'' then begin
|
|
Result:=FCreatedIdentifiers.Count-1;
|
|
while (Result>=0)
|
|
and (CompareIdentifiers(PChar(Pointer(Ident)),
|
|
PChar(Pointer(FCreatedIdentifiers[Result])))<>0)
|
|
do
|
|
dec(Result);
|
|
end else begin
|
|
Result:=-1;
|
|
end;
|
|
end;
|
|
|
|
function TIdentifierList.CreateIdentifier(const Ident: string): PChar;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Ident<>'' then begin
|
|
i:=FindCreatedIdentifier(Ident);
|
|
if i>=0 then
|
|
Result:=PChar(Pointer(FCreatedIdentifiers[i]))
|
|
else begin
|
|
GetMem(Result,length(Ident)+1);
|
|
Move(Ident[1],Result^,length(Ident)+1);
|
|
FCreatedIdentifiers.Add(Result);
|
|
end;
|
|
end else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TIdentifierList.StartUpAtomInFrontIs(const s: string): boolean;
|
|
begin
|
|
Result:=StartContext.Tool.FreeUpAtomIs(StartAtomInFront,s);
|
|
end;
|
|
|
|
function TIdentifierList.StartUpAtomBehindIs(const s: string): boolean;
|
|
begin
|
|
Result:=StartContext.Tool.FreeUpAtomIs(StartAtomBehind,s);
|
|
end;
|
|
|
|
function TIdentifierList.CompletePrefix(const OldPrefix: string): string;
|
|
// search all identifiers beginning with Prefix
|
|
// and return the biggest shared prefix of all of them
|
|
var
|
|
AnAVLNode: TAvgLvlTreeNode;
|
|
CurItem: TIdentifierListItem;
|
|
FoundFirst: Boolean;
|
|
SamePos: Integer;
|
|
l: Integer;
|
|
begin
|
|
Result:=OldPrefix;
|
|
FoundFirst:=false;
|
|
AnAVLNode:=FItems.FindLowest;
|
|
while AnAVLNode<>nil do begin
|
|
CurItem:=TIdentifierListItem(AnAVLNode.Data);
|
|
if (CurItem.Identifier<>'')
|
|
and ComparePrefixIdent(PChar(Pointer(Prefix)),PChar(Pointer(CurItem.Identifier)))
|
|
and (not (iliAtCursor in CurItem.Flags))
|
|
then begin
|
|
if not FoundFirst then begin
|
|
Result:=CurItem.Identifier;
|
|
FoundFirst:=true;
|
|
end else begin
|
|
SamePos:=length(Prefix)+1;
|
|
l:=length(Result);
|
|
if l>length(CurItem.Identifier) then
|
|
l:=length(CurItem.Identifier);
|
|
while (SamePos<=l)
|
|
and (UpChars[CurItem.Identifier[SamePos]]=UpChars[Result[SamePos]])
|
|
do
|
|
inc(SamePos);
|
|
if SamePos<=length(Result) then begin
|
|
Result:=copy(Result,1,SamePos-1);
|
|
if length(Result)=length(Prefix) then exit;
|
|
end;
|
|
end;
|
|
end;
|
|
AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
|
|
end;
|
|
end;
|
|
|
|
function TIdentifierList.CalcMemSize: PtrUInt;
|
|
var
|
|
i: Integer;
|
|
Node: TAVLTreeNode;
|
|
AvgNode: TAvgLvlTreeNode;
|
|
li: TIdentifierListItem;
|
|
hli: TIdentHistListItem;
|
|
begin
|
|
Result:=PtrUInt(InstanceSize)
|
|
+MemSizeString(FPrefix);
|
|
if FCreatedIdentifiers<>nil then begin
|
|
inc(Result,MemSizeFPList(FCreatedIdentifiers));
|
|
for i:=0 to FCreatedIdentifiers.Count-1 do
|
|
{%H-}inc(Result,GetIdentLen(PChar(FCreatedIdentifiers[i])));
|
|
end;
|
|
if FFilteredList<>nil then begin
|
|
inc(Result,MemSizeFPList(FFilteredList));
|
|
for i:=0 to FFilteredList.Count-1 do
|
|
inc(Result,TIdentifierListItem(FFilteredList[i]).CalcMemSize);
|
|
end;
|
|
if FHistory<>nil then begin
|
|
inc(Result,FHistory.CalcMemSize);
|
|
end;
|
|
if FItems<>nil then begin
|
|
{%H-}inc(Result,FItems.Count*SizeOf(TAvgLvlTreeNode));
|
|
AvgNode:=FItems.FindLowest;
|
|
while AvgNode<>nil do begin
|
|
li:=TIdentifierListItem(AvgNode.Data);
|
|
inc(Result,li.CalcMemSize);
|
|
AvgNode:=AvgNode.Successor;
|
|
end;
|
|
end;
|
|
if FIdentView<>nil then begin
|
|
{%H-}inc(Result,FIdentView.Count*SizeOf(TAVLTreeNode));
|
|
Node:=FIdentView.FindLowest;
|
|
while Node<>nil do begin
|
|
hli:=TIdentHistListItem(Node.Data);
|
|
inc(Result,hli.CalcMemSize);
|
|
Node:=FIdentView.FindSuccessor(Node);
|
|
end;
|
|
end;
|
|
if FIdentSearchItem<>nil then
|
|
inc(Result,FIdentSearchItem.CalcMemSize);
|
|
end;
|
|
|
|
{ TIdentCompletionTool }
|
|
|
|
procedure TIdentCompletionTool.AddToTreeOfUnitFileInfo(const AFilename: string);
|
|
begin
|
|
AddToTreeOfUnitFilesOrNamespaces(FIDTTreeOfUnitFiles,FIDTTreeOfNamespaces,
|
|
FIDTTreeOfUnitFiles_NamespacePath,AFilename,FIDTTreeOfUnitFiles_CaseInsensitive,false);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddCompilerProcedure(const AProcName, AParameterList: PChar);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
//DebugLn(['AddCompilerProcedure ',AProcName,' ',ilcfStartOfStatement in CurrentIdentifierList.ContextFlags]);
|
|
if (ilcfDontAllowProcedures in CurrentIdentifierList.ContextFlags) then exit;
|
|
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
false,
|
|
CompilerFuncHistoryIndex,
|
|
AProcName,
|
|
CompilerFuncLevel,
|
|
nil,
|
|
nil,
|
|
ctnProcedure);
|
|
NewItem.ParamTypeList:=AParameterList;
|
|
NewItem.ParamNameList:=AParameterList;
|
|
NewItem.Flags:=NewItem.Flags+[iliParamTypeListValid,iliParamNameListValid];
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddKeyWord(aKeyWord: string);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompExact,false,0,
|
|
CurrentIdentifierList.CreateIdentifier(aKeyWord),
|
|
1000,nil,nil,ctnNone);
|
|
include(NewItem.Flags,iliKeyword);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddCompilerFunction(const AProcName, AParameterList,
|
|
AResultType: PChar);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
false,
|
|
CompilerFuncHistoryIndex,
|
|
AProcName,
|
|
CompilerFuncLevel,
|
|
nil,
|
|
nil,
|
|
ctnProcedure);
|
|
NewItem.ParamTypeList:=AParameterList;
|
|
NewItem.ParamNameList:=AParameterList;
|
|
NewItem.ResultType:=AResultType;
|
|
NewItem.Flags:=NewItem.Flags+[iliParamTypeListValid,iliParamNameListValid,
|
|
iliIsFunction,iliIsFunctionValid,iliResultTypeValid];
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddBaseType(const BaseName: PChar);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
false,
|
|
CompilerFuncHistoryIndex,
|
|
BaseName,
|
|
CompilerFuncLevel,
|
|
nil,
|
|
nil,
|
|
ctnTypeDefinition);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddBaseConstant(const BaseName: PChar);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
false,
|
|
CompilerFuncHistoryIndex,
|
|
BaseName,
|
|
CompilerFuncLevel,
|
|
nil,
|
|
nil,
|
|
ctnConstant);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
function TIdentCompletionTool.CollectAllIdentifiers(
|
|
Params: TFindDeclarationParams; const FoundContext: TFindContext
|
|
): TIdentifierFoundResult;
|
|
var
|
|
Ident: PChar;
|
|
CurContextParent: TCodeTreeNode;
|
|
|
|
function ProtectedNodeIsInAllowedClass: boolean;
|
|
var
|
|
CurClassNode: TCodeTreeNode;
|
|
FoundClassContext: TFindContext;
|
|
begin
|
|
Result:=false;
|
|
if (FICTClassAndAncestorsAndExtClassOfHelper<>nil) then begin
|
|
// start of the identifier completion is in a method or class
|
|
// => all protected ancestor classes are allowed as well.
|
|
CurClassNode:=FoundContext.Node;
|
|
while (CurClassNode<>nil)
|
|
and (not (CurClassNode.Desc in AllClasses)) do
|
|
CurClassNode:=CurClassNode.Parent;
|
|
if CurClassNode=nil then exit;
|
|
FoundClassContext:=CreateFindContext(Params.NewCodeTool,CurClassNode);
|
|
if IndexOfFindContext(FICTClassAndAncestorsAndExtClassOfHelper,@FoundClassContext)>=0 then begin
|
|
// this class node is the class or one of the ancestors of the class or extended class of the helper+ancestors
|
|
// of the start context of the identifier completion
|
|
exit(true);
|
|
end;
|
|
end;
|
|
//DebugLn(['ProtectedNodeIsInAllowedClass hidden: ',FindContextToString(FoundContext)]);
|
|
end;
|
|
|
|
function PropertyIsOverridenPublicPublish: boolean;
|
|
begin
|
|
// protected properties can be made public in child classes.
|
|
//debugln('PropertyIsOverridenPublicPublish Identifier=',GetIdentifier(Ident),' Find=',dbgs((FIDCTFoundPublicProperties<>nil) and (FIDCTFoundPublicProperties.Find(Ident)<>nil)));
|
|
if FIDCTFoundPublicProperties<>nil then begin
|
|
if FIDCTFoundPublicProperties.Find(Ident)<>nil then begin
|
|
// there is a public/published property with the same name
|
|
exit(true);
|
|
end;
|
|
end;
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure SavePublicPublishedProperty;
|
|
begin
|
|
if FIDCTFoundPublicProperties=nil then begin
|
|
// create tree
|
|
FIDCTFoundPublicProperties:=
|
|
TAVLTree.Create(TListSortCompare(@CompareIdentifiers))
|
|
end else if FIDCTFoundPublicProperties.Find(Ident)<>nil then begin
|
|
// identifier is already public
|
|
exit;
|
|
end;
|
|
FIDCTFoundPublicProperties.Add(Ident);
|
|
//debugln('SavePublicPublishedProperty Identifier=',GetIdentifier(Ident),' Find=',dbgs(FIDCTFoundPublicProperties.Find(Ident)<>nil));
|
|
end;
|
|
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
Node: TCodeTreeNode;
|
|
ProtectedForeignClass: Boolean;
|
|
Lvl: LongInt;
|
|
NamePos: TAtomPosition;
|
|
HasLowerVisibility: Boolean;
|
|
begin
|
|
// proceed searching ...
|
|
Result:=ifrProceedSearch;
|
|
|
|
{$IFDEF ShowFoundIdents}
|
|
if FoundContext.Tool=Self then
|
|
DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
|
|
' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"'
|
|
,' '+dbgs(fdfIgnoreUsedUnits in Params.Flags));
|
|
{$ENDIF}
|
|
|
|
CurContextParent:=FoundContext.Node.GetFindContextParent;
|
|
if FLastGatheredIdentParent<>CurContextParent then begin
|
|
// new context level
|
|
FLastGatheredIdentParent:=CurContextParent;
|
|
inc(FLastGatheredIdentLevel);
|
|
end;
|
|
|
|
Lvl:=FLastGatheredIdentLevel;
|
|
HasLowerVisibility:=False;
|
|
|
|
ProtectedForeignClass:=false;
|
|
if FoundContext.Tool=Self then begin
|
|
// identifier is in the same unit
|
|
//DebugLn('::: COLLECT IDENT in SELF ',FoundContext.Node.DescAsString,
|
|
// ' "',dbgstr(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"'
|
|
// ,' fdfIgnoreUsedUnits='+dbgs(fdfIgnoreUsedUnits in Params.Flags));
|
|
if (FoundContext.Node=CurrentIdentifierList.StartContext.Node)
|
|
or (FoundContext.Node=CurrentIdentifierList.Context.Node)
|
|
or (FoundContext.Node.StartPos=CurrentIdentifierList.StartAtom.StartPos)
|
|
then begin
|
|
// found identifier is in cursor node
|
|
// => do not show it
|
|
exit;
|
|
end;
|
|
end else begin
|
|
// identifier is in another unit
|
|
Node:=FoundContext.Node.Parent;
|
|
if (Node<>nil) and (Node.Desc in AllClassSubSections) then
|
|
Node:=Node.Parent;
|
|
if (Node<>nil) and (Node.Desc in AllClassBaseSections) then begin
|
|
//debugln(['TIdentCompletionTool.CollectAllIdentifiers Node=',Node.DescAsString,' Context=',CurrentIdentifierList.Context.Node.DescAsString,' CtxVis=',NodeDescToStr(CurrentIdentifierList.NewMemberVisibility)]);
|
|
if (CurrentIdentifierList.NewMemberVisibility<>ctnNone)
|
|
and (CurrentIdentifierList.NewMemberVisibility<Node.Desc)
|
|
and (FoundContext.Node.Desc
|
|
in ([ctnProcedure,ctnProcedureHead,ctnProperty]+AllClassSections))
|
|
then begin
|
|
// the user wants to override a method or property
|
|
// => ignore all with a higher visibility, because fpc does not allow
|
|
// to downgrade the visibility and will give a hint when trying
|
|
//---- No, allow visibility downgrading to reduce confusion tha CodeTools do not list those functions.
|
|
//---- FPC actually allows it although it shows a warning
|
|
//debugln(['TIdentCompletionTool.CollectAllIdentifiers skipping member, because it would downgrade: ',dbgstr(FoundContext.Tool.ExtractNode(FoundContext.Node,[]),1,30)]);
|
|
HasLowerVisibility:=True;
|
|
end;
|
|
case Node.Desc of
|
|
ctnClassPrivate:
|
|
begin
|
|
// skip private definitions in other units
|
|
exit;
|
|
end;
|
|
ctnClassProtected:
|
|
begin
|
|
// protected definitions are only accessible from descendants
|
|
// or if visibility was raised (e.g. property)
|
|
if ProtectedNodeIsInAllowedClass then begin
|
|
// protected node in an ancestor => allowed
|
|
//debugln('TIdentCompletionTool.CollectAllIdentifiers ALLOWED Protected in ANCESTOR '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
|
|
end else if (FoundContext.Node.Desc=ctnProperty) then begin
|
|
// protected property: maybe the visibility was raised => continue
|
|
ProtectedForeignClass:=true;
|
|
//debugln('TIdentCompletionTool.CollectAllIdentifiers MAYBE Protected made Public '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
|
|
end else begin
|
|
// otherwise: treat as private
|
|
//debugln('TIdentCompletionTool.CollectAllIdentifiers FORBIDDEN Protected '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Ident:=nil;
|
|
case FoundContext.Node.Desc of
|
|
|
|
ctnTypeDefinition,ctnGenericType:
|
|
begin
|
|
Node:=FoundContext.Node.FirstChild;
|
|
if FoundContext.Node.Desc=ctnTypeDefinition then
|
|
Ident:=@FoundContext.Tool.Src[FoundContext.Node.StartPos]
|
|
else begin
|
|
// generic
|
|
if Node=nil then exit;
|
|
Ident:=@FoundContext.Tool.Src[Node.StartPos];
|
|
end;
|
|
if Node=nil then begin
|
|
// type without definition
|
|
end;
|
|
if (Node<>nil)
|
|
and (Node.Desc in AllClasses)
|
|
and ((ctnsForwardDeclaration and Node.SubDesc)>0)
|
|
then begin
|
|
// forward definition of a class
|
|
if CurrentIdentifierList.FindIdentifier(Ident,'')<>nil then begin
|
|
// the real class is already in the list => skip forward
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
ctnGenericParameter:
|
|
Ident:=@FoundContext.Tool.Src[FoundContext.Node.StartPos];
|
|
|
|
ctnVarDefinition,ctnConstDefinition,ctnEnumIdentifier,ctnLabel,ctnGlobalProperty:
|
|
Ident:=@FoundContext.Tool.Src[FoundContext.Node.StartPos];
|
|
|
|
ctnProcedure,ctnProcedureHead:
|
|
//do not list class constructors and destructors
|
|
if not FoundContext.Tool.NodeIsClassConstructorOrDestructor(FoundContext.Node) then
|
|
begin
|
|
Ident:=FoundContext.Tool.GetProcNameIdentifier(FoundContext.Node);
|
|
NewItem := CurrentIdentifierList.FindIdentifier(Ident,true);
|
|
if (NewItem<>nil) and (NewItem.Tool<>nil) then begin
|
|
if (NewItem.GetNode<>nil) then begin
|
|
if (FoundContext.Node.Parent.Desc in AllClassBaseSections)
|
|
<> (NewItem.Node.Parent.Desc in AllClassBaseSections)
|
|
then
|
|
exit; // class members hide normal procs and nested procs hide class members
|
|
if (Lvl <> NewItem.Level) then begin
|
|
// there is a previous declaration on a different level
|
|
if (NewItem.Node.Desc<>ctnProcedure)
|
|
or (not NewItem.Tool.ProcNodeHasSpecifier(NewItem.Node, psOVERLOAD))
|
|
then
|
|
exit; // there is a previous declaration without 'overload'
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
ctnProperty:
|
|
begin
|
|
Ident:=FoundContext.Tool.GetPropertyNameIdentifier(FoundContext.Node);
|
|
if FoundContext.Tool.PropNodeIsTypeLess(FoundContext.Node) then begin
|
|
if FoundContext.Node.Parent.Desc in [ctnClassPublic,ctnClassPublished]
|
|
then
|
|
SavePublicPublishedProperty;
|
|
// do not show properties without types (e.g. property Color;)
|
|
// only show the real definition, which will follow in the ancestor
|
|
exit;
|
|
end;
|
|
if (FoundContext.Node.Parent.Desc=ctnClassPrivate)
|
|
and (FoundContext.Tool<>Self)
|
|
and (not PropertyIsOverridenPublicPublish) then begin
|
|
// a private property in another unit, that was not
|
|
// made public/publish later
|
|
// => skip
|
|
exit;
|
|
end;
|
|
if (FoundContext.Node.Parent.Desc=ctnClassProtected)
|
|
and ProtectedForeignClass
|
|
and (not PropertyIsOverridenPublicPublish) then begin
|
|
// a protected property in another unit, that was not
|
|
// made public/publish later
|
|
// => skip
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
ctnRecordCase:
|
|
Ident:=@FoundContext.Tool.Src[Params.NewCleanPos];
|
|
|
|
ctnUseUnitNamespace,ctnUseUnitClearName:
|
|
if (FoundContext.Tool=Self) then begin
|
|
Ident:=@Src[FoundContext.Node.StartPos];
|
|
end;
|
|
|
|
ctnUnit,ctnProgram,ctnLibrary,ctnPackage:
|
|
if (FoundContext.Tool=Self)
|
|
and GetSourceNamePos(NamePos) then
|
|
Ident:=@Src[NamePos.StartPos];
|
|
|
|
end;
|
|
if Ident=nil then exit;
|
|
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
false,
|
|
0,
|
|
Ident,
|
|
Lvl,
|
|
FoundContext.Node,
|
|
FoundContext.Tool,
|
|
ctnNone);
|
|
|
|
//Add the '&' character to prefixed identifiers
|
|
if (Ident^='&') and (IsIdentStartChar[Ident[1]]) then
|
|
Include(NewItem.Flags,iliNeedsAmpersand);
|
|
|
|
// found identifier is in cursor node
|
|
if (FoundContext.Node=CurrentIdentifierList.StartContext.Node) then
|
|
Include(NewItem.Flags,iliAtCursor);
|
|
|
|
// method has lower visibility
|
|
if HasLowerVisibility then
|
|
Include(NewItem.Flags,iliHasLowerVisibility);
|
|
|
|
{$IFDEF ShowFoundIdents}
|
|
if FoundContext.Tool=Self then
|
|
DebugLn(' IDENT COLLECTED: ',NewItem.AsString);
|
|
{$ENDIF}
|
|
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.GatherPredefinedIdentifiers(CleanPos: integer;
|
|
const Context, GatherContext: TFindContext);
|
|
// Add predefined identifiers
|
|
|
|
function StatementLevel: integer;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=0;
|
|
ANode:=Context.Node;
|
|
while (ANode<>nil) and (not (ANode.Desc in [ctnBeginBlock,ctnAsmBlock])) do
|
|
begin
|
|
ANode:=ANode.Parent;
|
|
inc(Result);
|
|
end;
|
|
if ANode=nil then Result:=0;
|
|
end;
|
|
|
|
procedure AddSystemUnit(const AnUnitName: PChar);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CUnitNameSpaceIdentifierListItem.Create(
|
|
icompUnknown,
|
|
false,
|
|
CompilerFuncHistoryIndex,
|
|
AnUnitName,
|
|
CompilerFuncLevel,
|
|
nil,
|
|
nil,
|
|
ctnUseUnitClearName,
|
|
AnUnitName,
|
|
1);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
ProcNode: TCodeTreeNode;
|
|
HidddnUnits: String;
|
|
p: PChar;
|
|
SystemTool: TFindDeclarationTool;
|
|
I: TExpressionTypeDesc;
|
|
InSystemContext: Boolean;
|
|
begin
|
|
if CleanPos=0 then ;
|
|
|
|
SystemTool := FindCodeToolForUsedUnit('System','',False);
|
|
InSystemContext :=
|
|
(ilcfStartOfOperand in CurrentIdentifierList.ContextFlags) or
|
|
((ilcfStartIsSubIdent in CurrentIdentifierList.ContextFlags) and
|
|
(GatherContext.Tool<>nil) and (GatherContext.Node<>nil) and (SystemTool<>nil) and
|
|
(GatherContext.Tool = SystemTool) and (GatherContext.Node = SystemTool.FindInterfaceNode));
|
|
|
|
if InSystemContext and (Context.Node.Desc in AllPascalStatements) then
|
|
begin
|
|
// see fpc/compiler/psystem.pp
|
|
AddCompilerProcedure('Assert','Condition:Boolean;const Message:String');
|
|
AddCompilerFunction('Assigned','P:Pointer','Boolean');
|
|
AddCompilerFunction('Addr','var X','Pointer');
|
|
AddCompilerFunction('BitSizeOf','Identifier','Integer');
|
|
AddCompilerProcedure('Break','');
|
|
AddCompilerFunction('Concat','S1:String;S2:String[...;Sn:String]', 'String');
|
|
AddCompilerProcedure('Continue','');
|
|
if StrToIntDef(Scanner.Values['FPC_FULLVERSION'],0)>=30100 then // FromPosition and Count parameters are optional
|
|
AddCompilerFunction('Copy','const S:StringOrArray[;FromPosition,Count:Integer]', 'String')
|
|
else
|
|
AddCompilerFunction('Copy','const S:StringOrArray;FromPosition,Count:Integer', 'String');
|
|
AddCompilerProcedure('Dec','var X:Ordinal;N:Integer=1');
|
|
AddCompilerFunction('Default','T:Type','const');
|
|
if StrToIntDef(Scanner.Values['FPC_FULLVERSION'],0)>=30100 then //Delete and Insert are available as intrinsic since FPC 3.1
|
|
begin
|
|
AddCompilerProcedure('Delete','var S:string;Index,Count:Integer');
|
|
AddCompilerProcedure('Insert','const Source:string;var Dest:string;Index:Integer');
|
|
end;
|
|
AddCompilerProcedure('Dispose','var X:Pointer');
|
|
AddCompilerProcedure('Exclude','var S:Set;X:Ordinal');
|
|
AddCompilerProcedure('Exit','');
|
|
AddCompilerProcedure('Finalize','var X');
|
|
AddCompilerFunction('get_frame','','Pointer');
|
|
AddCompilerFunction('High','Arg:TypeOrVariable','Ordinal');
|
|
AddCompilerProcedure('Inc','var X:Ordinal;N:Integer=1');
|
|
AddCompilerProcedure('Include','var S:Set;X:Ordinal');
|
|
AddCompilerProcedure('Initialize','var X');
|
|
AddCompilerFunction('Length','S:String','Ordinal');
|
|
AddCompilerFunction('Length','A:Array','Ordinal');
|
|
AddCompilerFunction('Low','Arg:TypeOrVariable','Ordinal');
|
|
AddCompilerProcedure('New','var X:Pointer');
|
|
AddCompilerFunction('ObjCSelector','String','SEL');
|
|
AddCompilerFunction('Ofs','var X','LongInt');
|
|
AddCompilerFunction('Ord','X:Ordinal', 'Integer');
|
|
AddCompilerProcedure('Pack','A:Array;N:Integer;var A:Array');
|
|
AddCompilerFunction('Pred','X:Ordinal', 'Ordinal');
|
|
AddCompilerProcedure('Read','');
|
|
AddCompilerProcedure('ReadLn','');
|
|
AddCompilerProcedure('ReadStr','S:String;var Args:Arguments');
|
|
AddCompilerFunction('Seg','var X','LongInt');
|
|
AddCompilerProcedure('SetLength','var S:String;NewLength:Integer');
|
|
AddCompilerProcedure('SetLength','var A:Array;NewLength:Integer');
|
|
if Scanner.Values.IsDefined('FPC_HAS_CPSTRING') then
|
|
AddCompilerProcedure('SetString','out S:RawByteString;Buf:PAnsiChar;Len:SizeInt');
|
|
AddCompilerFunction('SizeOf','Identifier','Integer');
|
|
AddCompilerFunction('Slice','var A:Array;Count:Integer','Array');
|
|
AddCompilerProcedure('Str','const X[:Width[:Decimals]];var S:String');
|
|
AddCompilerFunction('Succ','X:Ordinal', 'Ordinal');
|
|
AddCompilerFunction('TypeInfo','Identifier', 'Pointer');
|
|
AddCompilerFunction('TypeOf','Identifier', 'Pointer');
|
|
AddCompilerProcedure('Val','S:String;var V;var Code:Integer');
|
|
AddCompilerFunction('Unaligned','var X','var'); // Florian declaration :)
|
|
AddCompilerProcedure('Unpack','A:Array;var A:Array;N:Integer');
|
|
AddCompilerProcedure('Write','Args:Arguments');
|
|
AddCompilerProcedure('WriteLn','Args:Arguments');
|
|
AddCompilerProcedure('WriteStr','var S:String;Args:Arguments');
|
|
end;
|
|
|
|
if (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags) and
|
|
(Context.Node.Desc in AllPascalStatements)
|
|
then
|
|
begin
|
|
if (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags)
|
|
and Context.Tool.NodeIsInAMethod(Context.Node)
|
|
and (not CurrentIdentifierList.HasIdentifier('Self','')) then begin
|
|
// method body -> add 'Self'
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
true,
|
|
1,
|
|
'Self',
|
|
StatementLevel,
|
|
nil,
|
|
nil,
|
|
ctnVarDefinition);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
ProcNode:=Context.Node.GetNodeOfType(ctnProcedure);
|
|
if (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags)
|
|
and Context.Tool.NodeIsFunction(ProcNode)
|
|
and (not CurrentIdentifierList.HasIdentifier('Result','')) then begin
|
|
// function body -> add 'Result'
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompUnknown,
|
|
true,
|
|
1,
|
|
'Result',
|
|
StatementLevel,
|
|
nil,
|
|
nil,
|
|
ctnVarDefinition);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
end;
|
|
|
|
// system types
|
|
if InSystemContext then
|
|
begin
|
|
for I := Low(I) to High(I) do
|
|
begin
|
|
case I of
|
|
xtChar..xtPointer, xtLongint..xtByte, xtVariant:
|
|
AddBaseType(PChar(ExpressionTypeDescNames[I]));
|
|
xtFile, xtText:
|
|
if not (ilcfStartInStatement in CurrentIdentifierList.ContextFlags) then
|
|
AddBaseType(PChar(ExpressionTypeDescNames[I]));
|
|
end;
|
|
end;
|
|
AddBaseConstant('True');
|
|
AddBaseConstant('False');
|
|
//the nil constant doesn't belong to system context, therefore it is added in next step
|
|
end;
|
|
if (ilcfStartOfOperand in CurrentIdentifierList.ContextFlags) then
|
|
begin
|
|
AddBaseConstant(PChar(ExpressionTypeDescNames[xtNil]));
|
|
// system units
|
|
HidddnUnits:=Scanner.GetHiddenUsedUnits;
|
|
if HidddnUnits<>'' then begin
|
|
p:=PChar(HidddnUnits);
|
|
while p^<>#0 do begin
|
|
while p^=',' do inc(p);
|
|
if GetIdentLen(p)>0 then
|
|
AddSystemUnit(p);
|
|
while not (p^ in [',',#0]) do inc(p);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.GatherUsefulIdentifiers(CleanPos: integer;
|
|
const Context, GatherContext: TFindContext);
|
|
|
|
procedure AddPropertyProc(ProcName: string);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompExact,true,0,
|
|
CurrentIdentifierList.CreateIdentifier(ProcName),
|
|
0,nil,nil,ctnProcedure);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
var
|
|
PropertyName: String;
|
|
begin
|
|
//debugln(['TIdentCompletionTool.GatherUsefulIdentifiers ',CleanPosToStr(CleanPos),' ',dbgsFC(Context)]);
|
|
GatherPredefinedIdentifiers(CleanPos,Context,GatherContext);
|
|
if Context.Node.Desc=ctnProperty then begin
|
|
PropertyName:=ExtractPropName(Context.Node,false);
|
|
//debugln('TIdentCompletionTool.GatherUsefulIdentifiers Property ',PropertyName);
|
|
MoveCursorToCleanPos(CleanPos);
|
|
ReadPriorAtom;
|
|
//debugln(['TIdentCompletionTool.GatherUsefulIdentifiers Atom=',GetAtom]);
|
|
if UpAtomIs('READ') then begin
|
|
// add the default class completion 'read' specifier function
|
|
AddPropertyProc(Beautifier.PropertyReadIdentPrefix+PropertyName);
|
|
end;
|
|
if UpAtomIs('WRITE') then begin
|
|
// add the default class completion 'write' specifier function
|
|
AddPropertyProc(Beautifier.PropertyWriteIdentPrefix+PropertyName);
|
|
end;
|
|
if (UpAtomIs('READ') or UpAtomIs('WRITE'))
|
|
and (Context.Tool.FindClassOrInterfaceNode(Context.Node)<>nil)
|
|
then begin
|
|
// add the default class completion 'read'/'write' specifier variable
|
|
AddPropertyProc(Beautifier.PrivateVariablePrefix+PropertyName);
|
|
end;
|
|
if UpAtomIs('STORED') then begin
|
|
// add the default class completion 'stored' specifier function
|
|
AddPropertyProc(PropertyName+Beautifier.PropertyStoredIdentPostfix);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.GatherUnitnames(const NameSpacePath: string);
|
|
|
|
procedure GatherUnitsFromSet;
|
|
begin
|
|
// collect all unit files in fpc unit paths
|
|
DirectoryCache.IterateFPCUnitsInSet(@AddToTreeOfUnitFileInfo);
|
|
end;
|
|
|
|
var
|
|
UnitPath, SrcPath: string;
|
|
BaseDir: String;
|
|
ANode: TAVLTreeNode;
|
|
UnitFileInfo: TUnitFileInfo;
|
|
NewItem: TUnitNameSpaceIdentifierListItem;
|
|
UnitExt: String;
|
|
SrcExt: String;
|
|
CurSourceName: String;
|
|
NameSpaceInfo: TNameSpaceInfo;
|
|
begin
|
|
UnitPath:='';
|
|
SrcPath:='';
|
|
GatherUnitAndSrcPath(UnitPath,SrcPath);
|
|
//DebugLn('TIdentCompletionTool.GatherUnitnames UnitPath="',UnitPath,'" SrcPath="',SrcPath,'"');
|
|
BaseDir:=ExtractFilePath(MainFilename);
|
|
FIDTTreeOfUnitFiles:=nil;
|
|
FIDTTreeOfNamespaces:=nil;
|
|
try
|
|
// search in unitpath
|
|
FIDTTreeOfUnitFiles_CaseInsensitive := true;
|
|
FIDTTreeOfUnitFiles_NamespacePath := NameSpacePath;
|
|
UnitExt:='pp;pas;ppu';
|
|
if Scanner.CompilerMode=cmMacPas then
|
|
UnitExt:=UnitExt+';p';
|
|
GatherUnitFiles(BaseDir,UnitPath,UnitExt,NameSpacePath,false,true,FIDTTreeOfUnitFiles, FIDTTreeOfNamespaces);
|
|
// search in srcpath
|
|
SrcExt:='pp;pas';
|
|
if Scanner.CompilerMode=cmMacPas then
|
|
SrcExt:=SrcExt+';p';
|
|
GatherUnitFiles(BaseDir,SrcPath,SrcExt,NameSpacePath,false,true,FIDTTreeOfUnitFiles, FIDTTreeOfNamespaces);
|
|
// add unitlinks
|
|
GatherUnitsFromSet;
|
|
// create list
|
|
CurSourceName:=GetSourceName;
|
|
if FIDTTreeOfUnitFiles<> nil then
|
|
begin
|
|
ANode:=FIDTTreeOfUnitFiles.FindLowest;
|
|
while ANode<>nil do begin
|
|
UnitFileInfo:=TUnitFileInfo(ANode.Data);
|
|
if CompareText(PChar(Pointer(UnitFileInfo.FileUnitName)), Length(UnitFileInfo.FileUnitName),
|
|
PChar(Pointer(CurSourceName)), Length(CurSourceName), False)<>0
|
|
then begin
|
|
NewItem:=CUnitNameSpaceIdentifierListItem.Create(
|
|
icompCompatible,true,0,
|
|
CurrentIdentifierList.CreateIdentifier(UnitFileInfo.FileUnitNameWithoutNamespace),
|
|
0,nil,nil,ctnUnit, PChar(UnitFileInfo.FileUnitName), UnitFileInfo.IdentifierStartInUnitName);
|
|
if NewItem.IdentifierStartInUnitName < 1 then
|
|
NewItem.IdentifierStartInUnitName := 1;
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
ANode:=FIDTTreeOfUnitFiles.FindSuccessor(ANode);
|
|
end;
|
|
end;
|
|
if FIDTTreeOfNamespaces<>nil then
|
|
begin
|
|
ANode:=FIDTTreeOfNamespaces.FindLowest;
|
|
while ANode<>nil do begin
|
|
NameSpaceInfo:=TNameSpaceInfo(ANode.Data);
|
|
NewItem:=CUnitNameSpaceIdentifierListItem.Create(
|
|
icompCompatible,true,0,
|
|
CurrentIdentifierList.CreateIdentifier(NameSpaceInfo.NameSpace),
|
|
0,nil,nil,ctnUseUnitNamespace, PChar(NameSpaceInfo.UnitName),
|
|
NameSpaceInfo.IdentifierStartInUnitName);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
ANode:=FIDTTreeOfNamespaces.FindSuccessor(ANode);
|
|
end;
|
|
end;
|
|
finally
|
|
FreeTreeOfUnitFiles(FIDTTreeOfUnitFiles);
|
|
FreeTreeOfUnitFiles(FIDTTreeOfNamespaces);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.GatherSourceNames(const Context: TFindContext);
|
|
|
|
procedure Add(const SrcName: string);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompExact,true,0,
|
|
CurrentIdentifierList.CreateIdentifier(SrcName),
|
|
0,nil,nil,Context.Node.Desc);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
var
|
|
NewSourceName: String;
|
|
FileSourceName: String;
|
|
begin
|
|
// add the unitname as in the filename and as in the source
|
|
FileSourceName:=ExtractFilenameOnly(MainFilename);
|
|
NewSourceName:=GetSourceName(false);
|
|
//DebugLn('TIdentCompletionTool.GatherSourceNames FileSourceName=',FileSourceName,' NewSourceName=',NewSourceName);
|
|
if (FileSourceName<>lowercase(FileSourceName)) then begin
|
|
// the file is not written lowercase => case is important, ignore source name
|
|
Add(FileSourceName);
|
|
end else if (SysUtils.CompareText(NewSourceName,FileSourceName)<>0) then begin
|
|
// source name is not correct => only use file name
|
|
Add(FileSourceName);
|
|
end else if NewSourceName=FileSourceName then begin
|
|
// both are the same => add only one
|
|
Add(FileSourceName);
|
|
end else begin
|
|
// both are valid, just different in case
|
|
// the filename is written lowercase
|
|
// => prefer the source name
|
|
Add(NewSourceName);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.GatherContextKeywords(
|
|
const Context: TFindContext; CleanPos: integer;
|
|
BeautifyCodeOptions: TBeautifyCodeOptions);
|
|
type
|
|
TPropertySpecifier = (
|
|
psIndex,psRead,psWrite,psStored,psImplements,psDefault,psNoDefault
|
|
);
|
|
TPropertySpecifiers = set of TPropertySpecifier;
|
|
|
|
procedure Add(Keyword: string);
|
|
var
|
|
NewItem: TIdentifierListItem;
|
|
begin
|
|
KeyWord:=BeautifyCodeOptions.BeautifyKeyWord(Keyword);
|
|
NewItem:=CIdentifierListItem.Create(
|
|
icompExact,false,0,
|
|
CurrentIdentifierList.CreateIdentifier(Keyword),
|
|
1000,nil,nil,ctnNone);
|
|
include(NewItem.Flags,iliKeyword);
|
|
CurrentIdentifierList.Add(NewItem);
|
|
end;
|
|
|
|
procedure AddSpecifiers(Forbidden: TPropertySpecifiers);
|
|
begin
|
|
if not (psIndex in Forbidden) then Add('index');
|
|
if not (psRead in Forbidden) then Add('read');
|
|
if not (psWrite in Forbidden) then Add('write');
|
|
if not (psStored in Forbidden) then Add('stored');
|
|
if not (psImplements in Forbidden) then Add('implements');
|
|
if not (psDefault in Forbidden) then Add('default');
|
|
if not (psNoDefault in Forbidden) then Add('nodefault');
|
|
end;
|
|
|
|
procedure CheckProperty(PropNode: TCodeTreeNode);
|
|
var
|
|
Forbidden: TPropertySpecifiers;
|
|
begin
|
|
if not MoveCursorToPropType(PropNode) then exit;
|
|
if CleanPos<CurPos.EndPos then exit;
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafPoint then begin
|
|
ReadNextAtom;
|
|
if CurPos.Flag<>cafWord then exit;
|
|
ReadNextAtom;
|
|
end;
|
|
Forbidden:=[];
|
|
repeat
|
|
if CleanPos<=CurPos.EndPos then begin
|
|
AddSpecifiers(Forbidden);
|
|
exit;
|
|
end;
|
|
if (not (psIndex in Forbidden)) and UpAtomIs('INDEX') then begin
|
|
ReadNextAtom;
|
|
Include(Forbidden,psIndex);
|
|
end else if (not (psRead in Forbidden)) and UpAtomIs('READ') then begin
|
|
ReadNextAtom;
|
|
Forbidden:=Forbidden+[psIndex..psRead];
|
|
end else if (not (psWrite in Forbidden)) and UpAtomIs('WRITE') then begin
|
|
ReadNextAtom;
|
|
Forbidden:=Forbidden+[psIndex..psWrite];
|
|
end else if (not (psImplements in Forbidden)) and UpAtomIs('IMPLEMENTS')
|
|
then begin
|
|
ReadNextAtom;
|
|
exit;
|
|
end else if (not (psStored in Forbidden)) and UpAtomIs('STORED') then
|
|
begin
|
|
ReadNextAtom;
|
|
Forbidden:=Forbidden+[psIndex..psImplements];
|
|
end else if (not (psDefault in Forbidden)) and UpAtomIs('DEFAULT') then
|
|
begin
|
|
ReadNextAtom;
|
|
exit;
|
|
end else if (not (psNoDefault in Forbidden)) and UpAtomIs('NODEFAULT') then
|
|
begin
|
|
ReadNextAtom;
|
|
exit;
|
|
end else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
|
|
if not ReadTilBracketClose(false) then exit;
|
|
end else
|
|
ReadNextAtom;
|
|
until (CleanPos<CurPos.StartPos) or (CurPos.EndPos>SrcLen);
|
|
end;
|
|
|
|
procedure AddMethodSpecifiers;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to IsKeyWordMethodSpecifier.Count-1 do
|
|
Add(IsKeyWordMethodSpecifier.GetItem(i).KeyWord+';');
|
|
end;
|
|
|
|
procedure AddProcSpecifiers;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to IsKeyWordProcedureSpecifier.Count-1 do
|
|
Add(IsKeyWordProcedureSpecifier.GetItem(i).KeyWord+';');
|
|
end;
|
|
|
|
procedure AddProcTypeSpecifiers;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to IsKeyWordProcedureTypeSpecifier.Count-1 do
|
|
Add(IsKeyWordProcedureTypeSpecifier.GetItem(i).KeyWord+';');
|
|
end;
|
|
|
|
var
|
|
Node: TCodeTreeNode;
|
|
SubNode: TCodeTreeNode;
|
|
NodeInFront: TCodeTreeNode;
|
|
p: Integer;
|
|
NodeBehind, LastChild: TCodeTreeNode;
|
|
begin
|
|
try
|
|
Node:=Context.Node;
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords ',Node.DescAsString]);
|
|
|
|
ReadPriorAtomSafe(CleanPos);
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords prioratom=',CleanPosToStr(CurPos.StartPos),'=',GetAtom(CurPos)]);
|
|
NodeInFront:=nil;
|
|
if CurPos.StartPos>0 then
|
|
NodeInFront:=FindDeepestNodeAtPos(CurPos.StartPos,false);
|
|
|
|
NodeBehind:=nil;
|
|
MoveCursorToCleanPos(CleanPos);
|
|
ReadNextAtom;
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords nextatom=',CleanPosToStr(CurPos.StartPos),'=',GetAtom(CurPos)]);
|
|
if CurPos.StartPos>CleanPos then
|
|
NodeBehind:=FindDeepestNodeAtPos(CurPos.StartPos,false);
|
|
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords Node=',Node.DescAsString,' NodeInFront=',NodeInFront.DescAsString,' NodeBehind=',NodeBehind.DescAsString]);
|
|
|
|
case Node.Desc of
|
|
ctnClass,ctnObject,ctnRecordType,ctnObjCCategory,ctnObjCClass,
|
|
ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
|
|
ctnClassPrivate,ctnClassProtected,ctnClassPublic,ctnClassPublished:
|
|
begin
|
|
Add('public');
|
|
Add('private');
|
|
Add('protected');
|
|
Add('published');
|
|
Add('procedure');
|
|
Add('function');
|
|
Add('property');
|
|
if (Node.Desc=ctnClass) or (Node.Parent.Desc=ctnClass) then begin
|
|
Add('constructor');
|
|
Add('destructor');
|
|
end;
|
|
if (Node.Desc=ctnRecordType) or (Node.Parent.Desc=ctnRecordType) then begin
|
|
Add('case');
|
|
end;
|
|
LastChild:=Node.LastChild;
|
|
if (LastChild<>nil) and (CleanPos>LastChild.StartPos)
|
|
and (LastChild.EndPos>LastChild.StartPos)
|
|
and (LastChild.EndPos<Srclen) then begin
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords end of class section ',dbgstr(copy(Src,Node.LastChild.EndPos-10,10))]);
|
|
SubNode:=LastChild;
|
|
if SubNode.Desc=ctnProperty then begin
|
|
CheckProperty(SubNode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
ctnClassInterface,ctnDispinterface,ctnObjCProtocol,ctnCPPClass:
|
|
begin
|
|
Add('procedure');
|
|
Add('function');
|
|
end;
|
|
|
|
ctnInterface,ctnImplementation:
|
|
begin
|
|
if (Node.FirstChild=nil)
|
|
or ((Node.FirstChild.Desc<>ctnUsesSection)
|
|
and (Node.FirstChild.StartPos>=CleanPos))
|
|
then
|
|
Add('uses');
|
|
Add('type');
|
|
Add('var');
|
|
Add('const');
|
|
Add('procedure');
|
|
Add('function');
|
|
Add('resourcestring');
|
|
if Node.Desc=ctnInterface then begin
|
|
Add('property');
|
|
end;
|
|
if (NodeBehind=nil)
|
|
or (NodeBehind.Desc in [ctnInitialization,ctnFinalization,ctnEndPoint,ctnBeginBlock])
|
|
then begin
|
|
if Node.Desc=ctnInterface then
|
|
Add('implementation');
|
|
Add('initialization');
|
|
Add('finalization');
|
|
end;
|
|
end;
|
|
|
|
ctnInitialization:
|
|
if (NodeBehind=nil)
|
|
or (NodeBehind.Desc in [ctnInitialization,ctnFinalization,ctnEndPoint,ctnBeginBlock])
|
|
then begin
|
|
Add('finalization');
|
|
Add('begin');
|
|
end;
|
|
|
|
ctnProcedure:
|
|
begin
|
|
Add('begin');
|
|
Add('type');
|
|
Add('var');
|
|
Add('const');
|
|
Add('procedure');
|
|
Add('function');
|
|
end;
|
|
|
|
ctnProcedureHead:
|
|
begin
|
|
MoveCursorBehindProcName(Node);
|
|
p:=CurPos.StartPos;
|
|
while (p>=1) and (Src[p] in [' ',#9]) do dec(p);
|
|
if CleanPos>=p then
|
|
AddMethodSpecifiers;
|
|
end;
|
|
|
|
ctnVarDefinition:
|
|
if Node.Parent.Desc in [ctnClass,ctnObject,ctnRecordType,ctnObjCCategory,ctnObjCClass]
|
|
+AllClassBaseSections
|
|
then begin
|
|
Add('public');
|
|
Add('private');
|
|
Add('protected');
|
|
Add('published');
|
|
Add('procedure');
|
|
Add('function');
|
|
Add('property');
|
|
if [cmsObjectiveC1,cmsObjectiveC2]*Scanner.CompilerModeSwitches<>[] then
|
|
begin
|
|
Add('required');
|
|
Add('optional');
|
|
end;
|
|
if (Node.Desc=ctnClass) or (Node.Parent.Desc=ctnClass) then begin
|
|
Add('constructor');
|
|
Add('destructor');
|
|
end;
|
|
if (Node.Desc=ctnRecordType) or (Node.Parent.Desc=ctnRecordType) then begin
|
|
Add('case');
|
|
end;
|
|
end;
|
|
|
|
ctnTypeSection,ctnVarSection,ctnConstSection,ctnLabelSection,ctnResStrSection,
|
|
ctnLibrary,ctnProgram:
|
|
begin
|
|
Add('type');
|
|
Add('const');
|
|
Add('var');
|
|
Add('resourcestring');
|
|
Add('procedure');
|
|
Add('function');
|
|
Add('property');
|
|
if Node.Desc=ctnLibrary then begin
|
|
Add('initialization');
|
|
Add('finalization');
|
|
Add('begin');
|
|
end;
|
|
end;
|
|
|
|
ctnProperty:
|
|
CheckProperty(Node);
|
|
|
|
end;
|
|
|
|
if NodeInFront<>nil then begin
|
|
if NodeInFront.Desc=ctnProcedureHead then begin
|
|
// procedure head postfix modifiers
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords NodeInFront.Parent=',NodeInFront.Parent.DescAsString]);
|
|
if NodeInFront.Parent.Desc=ctnProcedure then begin
|
|
//debugln(['TIdentCompletionTool.GatherContextKeywords NodeInFront.Parent.Parent=',NodeInFront.Parent.Parent.DescAsString]);
|
|
case NodeInFront.Parent.Parent.Desc of
|
|
ctnClass,ctnObject,ctnObjCCategory,ctnObjCClass,
|
|
ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
|
|
ctnClassPrivate,ctnClassProtected,ctnClassPublic,ctnClassPublished:
|
|
AddMethodSpecifiers;
|
|
else
|
|
AddProcSpecifiers;
|
|
end;
|
|
end else if NodeInFront.Parent.Desc=ctnProcedureType then
|
|
AddProcTypeSpecifiers;
|
|
end;
|
|
end;
|
|
except
|
|
// ignore parser errors
|
|
on E: ECodeToolError do ;
|
|
on E: ELinkScannerError do ;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.InitCollectIdentifiers(
|
|
const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList);
|
|
var
|
|
StartContext: TFindContext;
|
|
begin
|
|
if IdentifierList=nil then IdentifierList:=TIdentifierList.Create;
|
|
CurrentIdentifierList:=IdentifierList;
|
|
CurrentIdentifierList.Clear;
|
|
FLastGatheredIdentParent:=nil;
|
|
FLastGatheredIdentLevel:=0;
|
|
CurrentIdentifierList.StartContextPos:=CursorPos;
|
|
StartContext := CurrentIdentifierList.StartContext;
|
|
StartContext.Tool := Self;
|
|
CurrentIdentifierList.StartContext:=StartContext;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.ParseSourceTillCollectionStart(
|
|
const CursorPos: TCodeXYPosition; out CleanCursorPos: integer;
|
|
out CursorNode: TCodeTreeNode; out IdentStartPos, IdentEndPos: integer);
|
|
var
|
|
StartContext: TFindContext;
|
|
ContextPos: Integer;
|
|
begin
|
|
CleanCursorPos:=0;
|
|
CursorNode:=nil;
|
|
IdentStartPos:=0;
|
|
IdentEndPos:=0;
|
|
|
|
// build code tree
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn(['TIdentCompletionTool.ParseSourceTillCollectionStart A CursorPos=',dbgs(CursorPos)]);
|
|
{$ENDIF}
|
|
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
|
|
[btSetIgnoreErrorPos]);
|
|
if FindDeepestNodeAtPos(CleanCursorPos,false)=nil then begin
|
|
debugln(['TIdentCompletionTool.ParseSourceTillCollectionStart',
|
|
' BuildTreeAndGetCleanPos worked, but no node found.',
|
|
' CursorPos=',dbgs(CursorPos),' CleanCursorPos=',CleanCursorPos,
|
|
' ScannedRange=',dbgs(ScannedRange),
|
|
' Scanner.ScannedRange=',dbgs(Scanner.ScannedRange),
|
|
' IgnoreErrorAfterValid=',IgnoreErrorAfterValid
|
|
]);
|
|
if IgnoreErrorAfterValid then
|
|
debugln([' IgnoreErrorAfter=',dbgs(IgnoreErrorAfter),' IgnoreErrorAfterCleanedPos=',IgnoreErrorAfterCleanedPos,' CleanPosIsAfterIgnorePos=',CleanPosIsAfterIgnorePos(CleanCursorPos)]);
|
|
if CursorPos.Y<=CursorPos.Code.LineCount then
|
|
debugln([' Line=',dbgstr(CursorPos.Code.GetLine(CursorPos.Y-1,true),1,CursorPos.X-1),'|',dbgstr(CursorPos.Code.GetLine(CursorPos.Y-1,true),CursorPos.X,100)]);
|
|
CursorNode:=Tree.Root;
|
|
if CursorNode=nil then begin
|
|
debugln([' no nodes']);
|
|
end else begin
|
|
while CursorNode.NextBrother<>nil do
|
|
CursorNode:=CursorNode.NextBrother;
|
|
while CursorNode<>nil do begin
|
|
debugln([' Node=',CursorNode.DescAsString,',Start=',CursorNode.StartPos,',End=',CursorNode.EndPos,',Src="...',dbgstr(RightStr(ExtractNode(CursorNode,[]),100)),'"']);
|
|
CursorNode:=CursorNode.LastChild;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// find node at position
|
|
ContextPos:=CleanCursorPos;
|
|
// The context node might be in front of the CleanCursorPos
|
|
// For example: A.|end; In this case the statement ends at the point.
|
|
// Check the atom in front
|
|
ReadPriorAtomSafe(CleanCursorPos);
|
|
if (CurPos.Flag<>cafNone) then begin
|
|
if (CurPos.Flag in [cafPoint,cafRoundBracketOpen,cafEdgedBracketOpen])
|
|
or UpAtomIs('INHERITED') then
|
|
ContextPos:=CurPos.StartPos;
|
|
end;
|
|
|
|
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(ContextPos,true);
|
|
if CurrentIdentifierList<>nil then begin
|
|
StartContext:=CurrentIdentifierList.StartContext;
|
|
StartContext.Node:=CursorNode;
|
|
CurrentIdentifierList.StartContext:=StartContext;
|
|
end;
|
|
|
|
// get identifier position
|
|
if CursorPos.Code.LineColIsOutside(CursorPos.Y,CursorPos.X) then begin
|
|
IdentStartPos:=CleanCursorPos;
|
|
IdentEndPos:=CleanCursorPos;
|
|
end else begin
|
|
GetIdentStartEndAtPosition(Src,CleanCursorPos,IdentStartPos,IdentEndPos);
|
|
end;
|
|
//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)]);
|
|
if CursorPos.X>CursorPos.Code.GetLineLength(CursorPos.Y-1)+1 then
|
|
IdentStartPos:=IdentEndPos;
|
|
end;
|
|
|
|
function TIdentCompletionTool.FindIdentifierStartPos(
|
|
const CursorPos: TCodeXYPosition): TCodeXYPosition;
|
|
var
|
|
p: integer;
|
|
IdentStartPos, IdentEndPos: integer;
|
|
begin
|
|
CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,p);
|
|
if p<1 then
|
|
RaiseException(ctsCursorPosOutsideOfCode);
|
|
if CursorPos.X<=CursorPos.Code.GetLineLength(CursorPos.Y-1)+1 then begin
|
|
GetIdentStartEndAtPosition(CursorPos.Code.Source,p,IdentStartPos,IdentEndPos);
|
|
end else begin
|
|
IdentStartPos:=p;
|
|
IdentEndPos:=p;
|
|
end;
|
|
Result:=CursorPos;
|
|
if IdentStartPos>0 then
|
|
dec(Result.X,p-IdentStartPos);
|
|
//DebugLn(['TIdentCompletionTool.FindIdentifierStartPos ',dbgstr(copy(CursorPos.Code.Source,IdentStartPos,20))]);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.FindCollectionContext(
|
|
Params: TFindDeclarationParams; IdentStartPos: integer;
|
|
CursorNode: TCodeTreeNode; out ExprType: TExpressionType; out
|
|
ContextExprStartPos: LongInt; out StartInSubContext,
|
|
HasInheritedKeyword: Boolean);
|
|
|
|
function GetContextExprStartPos(IdentStartPos: integer;
|
|
ContextNode: TCodeTreeNode): integer;
|
|
begin
|
|
MoveCursorToCleanPos(IdentStartPos);
|
|
ReadPriorAtom;
|
|
HasInheritedKeyword := UpAtomIs('INHERITED');
|
|
if (CurPos.Flag=cafPoint)
|
|
or HasInheritedKeyword then begin
|
|
Result:=FindStartOfTerm(IdentStartPos,NodeTermInType(ContextNode));
|
|
if Result<ContextNode.StartPos then
|
|
Result:=ContextNode.StartPos;
|
|
end else
|
|
Result:=IdentStartPos;
|
|
MoveCursorToCleanPos(Result);
|
|
ReadNextAtom;
|
|
case ContextNode.Desc of
|
|
ctnProperty:
|
|
// check for special property keywords
|
|
if WordIsPropertySpecifier.DoItCaseInsensitive(Src,
|
|
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
|
|
then
|
|
// do not resolve property specifiers
|
|
Result:=IdentStartPos;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
IgnoreCurContext: Boolean;
|
|
GatherContext: TFindContext;
|
|
begin
|
|
GatherContext:=CreateFindContext(Self,CursorNode);
|
|
ExprType := CleanExpressionType;
|
|
|
|
IgnoreCurContext:=false;
|
|
//DebugLn(['TIdentCompletionTool.FindCollectionContext IdentStartPos=',dbgstr(copy(Src,IdentStartPos,20)),' ',CursorNode.DescAsString]);
|
|
ContextExprStartPos:=GetContextExprStartPos(IdentStartPos,CursorNode);
|
|
if GatherContext.Node.Desc=ctnWithVariable then begin
|
|
if GatherContext.Node.PriorBrother<>nil then
|
|
GatherContext.Node:=GatherContext.Node.PriorBrother
|
|
else
|
|
GatherContext.Node:=GatherContext.Node.Parent;
|
|
end
|
|
else if (GatherContext.Node.GetNodeOfType(ctnClassInheritance)<>nil) then
|
|
begin
|
|
while not (GatherContext.Node.Desc in AllClasses) do
|
|
GatherContext.Node:=GatherContext.Node.Parent;
|
|
GatherContext.Node:=GatherContext.Node.Parent;
|
|
IgnoreCurContext:=true;
|
|
end else if GatherContext.Node.Desc=ctnIdentifier then begin
|
|
IgnoreCurContext:=true;
|
|
end;
|
|
|
|
StartInSubContext:=false;
|
|
//DebugLn(['TIdentCompletionTool.FindCollectionContext ContextExprStartPos=',ContextExprStartPos,' "',dbgstr(copy(Src,ContextExprStartPos,20)),'" IdentStartPos="',dbgstr(copy(Src,IdentStartPos,20)),'" Gather=',FindContextToString(GatherContext)]);
|
|
if ContextExprStartPos<IdentStartPos then begin
|
|
MoveCursorToCleanPos(IdentStartPos);
|
|
Params.ContextNode:=CursorNode;
|
|
Params.SetIdentifier(Self,nil,nil);
|
|
Params.Flags:=[fdfExceptionOnNotFound,
|
|
fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,fdfTypeType];
|
|
if IgnoreCurContext then
|
|
Params.Flags:=Params.Flags+[fdfIgnoreCurContextNode];
|
|
ExprType:=FindExpressionTypeOfTerm(ContextExprStartPos,IdentStartPos,
|
|
Params,false);
|
|
if ExprType.Desc=xtContext then begin
|
|
GatherContext:=ExprType.Context;
|
|
//debugln(['TIdentCompletionTool.FindCollectionContext ',ExprTypeToString(ExprType)]);
|
|
StartInSubContext:=true;
|
|
end else begin
|
|
// for example "string.|"
|
|
GatherContext:=CleanFindContext;
|
|
end;
|
|
end;
|
|
ExprType.Context := GatherContext;
|
|
end;
|
|
|
|
function TIdentCompletionTool.CollectAllContexts(
|
|
Params: TFindDeclarationParams; const FoundContext: TFindContext
|
|
): TIdentifierFoundResult;
|
|
begin
|
|
Result:=ifrProceedSearch;
|
|
if FoundContext.Node=nil then exit;
|
|
//DebugLn(['TIdentCompletionTool.CollectAllContexts ',FoundContext.Node.DescAsString]);
|
|
case FoundContext.Node.Desc of
|
|
ctnProcedure:
|
|
begin
|
|
//DebugLn('TIdentCompletionTool.CollectAllContexts CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentIdentifierContexts.ProcNameAtom.StartPos));
|
|
if (CurrentIdentifierContexts.ProcName='') then exit;
|
|
FoundContext.Tool.MoveCursorToProcName(FoundContext.Node,true);
|
|
//DebugLn(['TIdentCompletionTool.CollectAllContexts ProcName=',GetIdentifier(@FoundContext.Tool.Src[FoundContext.Tool.CurPos.StartPos])]);
|
|
if FoundContext.Tool.CompareSrcIdentifiers(
|
|
FoundContext.Tool.CurPos.StartPos,
|
|
PChar(CurrentIdentifierContexts.ProcName))
|
|
then begin
|
|
// method without 'overload' hides inherited one
|
|
if not FoundContext.Tool.ProcNodeHasSpecifier(FoundContext.Node, psOVERLOAD) then
|
|
Exclude(Params.Flags, fdfSearchInAncestors);
|
|
end else exit
|
|
end;
|
|
ctnProperty,ctnGlobalProperty:
|
|
begin
|
|
if (CurrentIdentifierContexts.ProcName='') then exit;
|
|
FoundContext.Tool.MoveCursorToPropName(FoundContext.Node);
|
|
if not FoundContext.Tool.CompareSrcIdentifiers(
|
|
FoundContext.Tool.CurPos.StartPos,
|
|
PChar(CurrentIdentifierContexts.ProcName))
|
|
then exit;
|
|
end;
|
|
ctnVarDefinition:
|
|
begin
|
|
//debugln(['TIdentCompletionTool.CollectAllContexts ',FoundContext.Tool.ExtractNode(FoundContext.Node,[])]);
|
|
if (CurrentIdentifierContexts.ProcName='') then exit;
|
|
if not FoundContext.Tool.CompareSrcIdentifiers(
|
|
FoundContext.Node.StartPos,
|
|
PChar(CurrentIdentifierContexts.ProcName))
|
|
then exit;
|
|
end;
|
|
else
|
|
exit;
|
|
end;
|
|
{$IFDEF VerboseCodeContext}
|
|
DebugLn(['TIdentCompletionTool.CollectAllContexts add ',FoundContext.Node.DescAsString]);
|
|
{$ENDIF}
|
|
AddCollectionContext(FoundContext.Tool,FoundContext.Node);
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddCollectionContext(Tool: TFindDeclarationTool;
|
|
Node: TCodeTreeNode);
|
|
begin
|
|
if CurrentIdentifierContexts=nil then
|
|
CurrentIdentifierContexts:=TCodeContextInfo.Create;
|
|
CurrentIdentifierContexts.Add(CreateExpressionType(xtContext,xtNone,
|
|
CreateFindContext(Tool,Node)));
|
|
//DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[]));
|
|
end;
|
|
|
|
function TIdentCompletionTool.CheckCursorInCompilerDirective(CursorPos: TCodeXYPosition
|
|
): boolean;
|
|
var
|
|
Line: String;
|
|
p: Integer;
|
|
EndPos: Integer;
|
|
InnerStart: Integer;
|
|
Directive: String;
|
|
ms: TCompilerModeSwitch;
|
|
cm: TCompilerMode;
|
|
OptimizerSwitch: TOptimizerSwitch;
|
|
begin
|
|
Result:=false;
|
|
Line:=CursorPos.Code.GetLine(CursorPos.Y-1,false);
|
|
p:=1;
|
|
while p<=length(Line) do begin
|
|
p:=FindNextCompilerDirective(Line,p,Scanner.NestedComments);
|
|
if p>length(Line) then exit;
|
|
EndPos:=FindCommentEnd(Line,p,Scanner.NestedComments);
|
|
if (CursorPos.X>p) and (CursorPos.X<EndPos) then begin
|
|
// in a directive
|
|
Result:=true;
|
|
InnerStart:=p;
|
|
if Line[InnerStart]='{' then
|
|
inc(InnerStart,2)
|
|
else
|
|
inc(InnerStart,3);
|
|
//debugln(['TIdentCompletionTool.IsInCompilerDirective InnerStart=',InnerStart,' X=',CursorPos.X]);
|
|
if (InnerStart=CursorPos.X)
|
|
or ((CursorPos.X>=InnerStart) and (InnerStart<=length(Line))
|
|
and (CursorPos.X<=InnerStart+GetIdentLen(@Line[InnerStart])))
|
|
then begin
|
|
// at start of directive
|
|
// see fpc/compiler/scandir.pas (incomplete list, e.g. Define is missing there)
|
|
AddKeyWord('A1');
|
|
AddKeyWord('A2');
|
|
AddKeyWord('A4');
|
|
AddKeyWord('A8');
|
|
AddKeyWord('Align');
|
|
AddKeyWord('AlignAssertions');
|
|
AddKeyWord('AppID');
|
|
AddKeyWord('AppName');
|
|
AddKeyWord('AppType');
|
|
AddKeyWord('AsmMode');
|
|
AddKeyWord('Assertions');
|
|
AddKeyWord('BitPacking');
|
|
AddKeyWord('BoolEval');
|
|
AddKeyWord('Calling');
|
|
AddKeyWord('CheckLowAddrLoads');
|
|
AddKeyWord('CheckPointer');
|
|
AddKeyWord('CodeAlign');
|
|
AddKeyWord('Codepage');
|
|
AddKeyWord('COperators');
|
|
AddKeyWord('Copyright');
|
|
AddKeyWord('D');
|
|
AddKeyWord('DebugInfo');
|
|
AddKeyWord('Define');
|
|
AddKeyWord('Description');
|
|
AddKeyWord('ElIfC');
|
|
AddKeyWord('Else');
|
|
AddKeyWord('ElseC');
|
|
AddKeyWord('ElseIf');
|
|
AddKeyWord('EndC');
|
|
AddKeyWord('EndIf');
|
|
AddKeyWord('EndRegion');
|
|
AddKeyWord('Error');
|
|
AddKeyWord('ErrorC');
|
|
AddKeyWord('ExtendedSyntax');
|
|
AddKeyWord('ExternalSym');
|
|
AddKeyWord('F');
|
|
AddKeyWord('Fatal');
|
|
AddKeyWord('FPUType');
|
|
AddKeyWord('FrameworkPath');
|
|
AddKeyWord('Goto');
|
|
AddKeyWord('Hint');
|
|
AddKeyWord('Hints');
|
|
AddKeyWord('HPPEmit');
|
|
AddKeyWord('HugeCode');
|
|
AddKeyWord('HugePointerArithmetikNormalization');
|
|
AddKeyWord('HugePointerComparisonNormalization');
|
|
AddKeyWord('HugePointerNormalization');
|
|
AddKeyWord('IEEEErrors');
|
|
AddKeyWord('IfC');
|
|
AddKeyWord('IfDef');
|
|
AddKeyWord('IfEnd');
|
|
AddKeyWord('IfNDef');
|
|
AddKeyWord('IfOpt');
|
|
AddKeyWord('ImageBase');
|
|
AddKeyWord('ImplicitExceptions');
|
|
AddKeyWord('Include');
|
|
AddKeyWord('IncludePath');
|
|
AddKeyWord('Info');
|
|
AddKeyWord('Inline');
|
|
AddKeyWord('Interfaces');
|
|
AddKeyWord('IOChecks');
|
|
AddKeyWord('L');
|
|
AddKeyWord('LibExport');
|
|
AddKeyWord('LibraryPath');
|
|
AddKeyWord('Link');
|
|
AddKeyWord('LinkFramework');
|
|
AddKeyWord('LinkLib');
|
|
AddKeyWord('LocalSymbols');
|
|
AddKeyWord('LongStrings');
|
|
AddKeyWord('M');
|
|
AddKeyWord('Macro');
|
|
AddKeyWord('MaxFPURegisters');
|
|
AddKeyWord('MaxStackSize');
|
|
AddKeyWord('Memory');
|
|
AddKeyWord('Message');
|
|
AddKeyWord('MinEnumSize');
|
|
AddKeyWord('MinFPConstPrec');
|
|
AddKeyWord('MMX');
|
|
AddKeyWord('Mode');
|
|
AddKeyWord('ModeSwitch');
|
|
AddKeyWord('NameSpace');
|
|
AddKeyWord('Note');
|
|
AddKeyWord('Notes');
|
|
AddKeyWord('ObjectChecks');
|
|
AddKeyWord('ObjectPath');
|
|
AddKeyWord('OpenStrings');
|
|
AddKeyWord('Optimization');
|
|
AddKeyWord('Output_Format');
|
|
AddKeyWord('OV');
|
|
AddKeyWord('OverflowChecks');
|
|
AddKeyWord('PackEnum');
|
|
AddKeyWord('PackRecords');
|
|
AddKeyWord('PackSet');
|
|
AddKeyWord('PIC');
|
|
AddKeyWord('PointerMath');
|
|
AddKeyWord('Pop');
|
|
AddKeyWord('Profile');
|
|
AddKeyWord('Push');
|
|
AddKeyWord('R');
|
|
AddKeyWord('RangeChecks');
|
|
AddKeyWord('ReferenceInfo');
|
|
AddKeyWord('Region');
|
|
AddKeyWord('Resource');
|
|
AddKeyWord('SafeFPUExceptions');
|
|
AddKeyWord('Saturation');
|
|
AddKeyWord('ScopedEnums');
|
|
AddKeyWord('ScreenName');
|
|
AddKeyWord('SetC');
|
|
AddKeyWord('SetPEFlags');
|
|
AddKeyWord('SetPEOptFlags');
|
|
AddKeyWord('SmartLink');
|
|
AddKeyWord('StackFrames');
|
|
AddKeyWord('Stop');
|
|
AddKeyWord('StringChecks');
|
|
AddKeyWord('Syscall');
|
|
AddKeyWord('TargetSwitch');
|
|
AddKeyWord('ThreadName');
|
|
AddKeyWord('TypedAddress');
|
|
AddKeyWord('TypeInfo');
|
|
AddKeyWord('UnDef');
|
|
AddKeyWord('UnitPath');
|
|
AddKeyWord('VarParaCopyOutCheck');
|
|
AddKeyWord('VarPropSetter');
|
|
AddKeyWord('VarStringChecks');
|
|
AddKeyWord('Wait');
|
|
AddKeyWord('Warn');
|
|
AddKeyWord('Warning');
|
|
AddKeyWord('Warnings');
|
|
AddKeyWord('WeakPackageUnit');
|
|
AddKeyWord('WriteableConst'); // unusual spelling in fpc
|
|
AddKeyWord('Z1');
|
|
AddKeyWord('Z2');
|
|
AddKeyWord('Z4');
|
|
AddKeyWord('ZeroBasedStrings');
|
|
end else if InnerStart<=length(Line) then begin
|
|
// in parameter of directive
|
|
Directive:=lowercase(GetIdentifier(@Line[InnerStart]));
|
|
if (Directive='ifdef')
|
|
or (Directive='ifndef')
|
|
or (Directive='if')
|
|
or (Directive='elseif')
|
|
or (Directive='ifc')
|
|
then begin
|
|
AddCompilerDirectiveMacros(Directive);
|
|
end else if Directive='modeswitch' then begin
|
|
for ms:=low(TCompilerModeSwitch) to high(TCompilerModeSwitch) do
|
|
AddKeyWord(lowercase(CompilerModeSwitchNames[ms]));
|
|
end else if Directive='mode' then begin
|
|
for cm:=low(TCompilerMode) to high(TCompilerMode) do
|
|
AddKeyWord(lowercase(CompilerModeNames[cm]));
|
|
end else if Directive='warn' then begin
|
|
AddKeyWord('constructing_abstract');
|
|
AddKeyWord('implicit_variants');
|
|
AddKeyWord('no_retval');
|
|
AddKeyWord('symbol_deprecated');
|
|
AddKeyWord('symbol_experimental');
|
|
AddKeyWord('symbol_library');
|
|
AddKeyWord('symbol_platform');
|
|
AddKeyWord('symbol_unimplemented');
|
|
AddKeyWord('unit_deprecated');
|
|
AddKeyWord('unit_experimental');
|
|
AddKeyWord('unit_library');
|
|
AddKeyWord('unit_platform');
|
|
AddKeyWord('unit_unimplemented');
|
|
AddKeyWord('zero_nil_compat');
|
|
AddKeyWord('implicit_string_cast');
|
|
AddKeyWord('implicit_variants');
|
|
AddKeyWord('no_retval');
|
|
AddKeyWord('symbol_deprecated');
|
|
AddKeyWord('symbol_experimental');
|
|
AddKeyWord('symbol_library');
|
|
AddKeyWord('symbol_platform');
|
|
AddKeyWord('symbol_unimplemented');
|
|
AddKeyWord('unit_deprecated');
|
|
AddKeyWord('unit_experimental');
|
|
AddKeyWord('unit_library');
|
|
AddKeyWord('unit_platform');
|
|
AddKeyWord('unit_unimplemented');
|
|
AddKeyWord('zero_nil_compat');
|
|
AddKeyWord('implicit_string_cast');
|
|
AddKeyWord('implicit_string_cast_loss');
|
|
AddKeyWord('explicit_string_cast');
|
|
AddKeyWord('explicit_string_cast_loss');
|
|
AddKeyWord('cvt_narrowing_string_lost');
|
|
end else if (Directive='i') or (Directive='include') then begin
|
|
AddKeyWord('Date');
|
|
AddKeyWord('FPCTarget');
|
|
AddKeyWord('FPCTargetOS');
|
|
AddKeyWord('FPCTargetCPU');
|
|
AddKeyWord('FPCVersion');
|
|
AddKeyWord('Time');
|
|
AddKeyWord('CurrentRoutine'); // since FPC 3.1+
|
|
AddKeyWord('Line'); // since FPC 3.1+
|
|
end else if (Directive='codepage') then begin
|
|
// see fpcsrc/compiler/widestr.pas
|
|
AddKeyWord('UTF8');
|
|
AddKeyWord('cp1250');
|
|
AddKeyWord('cp1251');
|
|
AddKeyWord('cp1252');
|
|
AddKeyWord('cp1253');
|
|
AddKeyWord('cp1254');
|
|
AddKeyWord('cp1255');
|
|
AddKeyWord('cp1256');
|
|
AddKeyWord('cp1257');
|
|
AddKeyWord('cp1258');
|
|
AddKeyWord('cp437');
|
|
AddKeyWord('cp646');
|
|
AddKeyWord('cp850');
|
|
AddKeyWord('cp852');
|
|
AddKeyWord('cp856');
|
|
AddKeyWord('cp866');
|
|
AddKeyWord('cp874');
|
|
AddKeyWord('cp8859_1');
|
|
AddKeyWord('cp8859_2');
|
|
AddKeyWord('cp8859_5');
|
|
end else if Directive='interfaces' then begin
|
|
AddKeyWord('COM');
|
|
AddKeyWord('CORBA');
|
|
end else if Directive='optimization' then begin
|
|
for OptimizerSwitch in TOptimizerSwitch do
|
|
AddKeyWord(OptimizerSwitchStr[OptimizerSwitch]);
|
|
end;
|
|
end;
|
|
exit;
|
|
end;
|
|
p:=EndPos;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.AddCompilerDirectiveMacros(Directive: string);
|
|
var
|
|
Macros: TStringToStringTree;
|
|
StrItem: PStringToStringTreeItem;
|
|
CodeBufs: TAVLTree;
|
|
AVLNode: TAVLTreeNode;
|
|
|
|
procedure Add(e: TExpressionEvaluator);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to e.Count-1 do
|
|
Macros[e.Names(i)]:=e.Values(i);
|
|
end;
|
|
|
|
procedure AddExprWords(CodeBuf: TCodeBuffer);
|
|
var
|
|
CurSrc: String;
|
|
p: Integer;
|
|
sp: PChar;
|
|
NamePos: PChar;
|
|
EndP: PChar;
|
|
CurName: String;
|
|
begin
|
|
p:=1;
|
|
CurSrc:=CodeBuf.Source;
|
|
while p<=length(CurSrc) do begin
|
|
p:=FindNextCompilerDirective(CurSrc,p,Scanner.NestedComments);
|
|
if p>length(CurSrc) then break;
|
|
sp:=@CurSrc[p];
|
|
p:=FindCommentEnd(CurSrc,p,Scanner.NestedComments);
|
|
// skip comment start
|
|
if sp^='{' then inc(sp,2)
|
|
else if sp^='(' then inc(sp,3);
|
|
if not IsIdentStartChar[sp^] then break;
|
|
NamePos:=sp;
|
|
inc(sp,GetIdentLen(NamePos));
|
|
if sp^=#0 then break;
|
|
if (CompareIdentifiers(NamePos,'ifdef')=0)
|
|
or (CompareIdentifiers(NamePos,'ifndef')=0)
|
|
or (CompareIdentifiers(NamePos,'if')=0)
|
|
or (CompareIdentifiers(NamePos,'ifc')=0)
|
|
or (CompareIdentifiers(NamePos,'elseif')=0)
|
|
or (CompareIdentifiers(NamePos,'elifc')=0)
|
|
or (CompareIdentifiers(NamePos,'define')=0)
|
|
or (CompareIdentifiers(NamePos,'unde')=0)
|
|
or (CompareIdentifiers(NamePos,'setc')=0)
|
|
then begin
|
|
// add all identifiers in directive
|
|
if p>length(CurSrc) then
|
|
EndP:=PChar(CurSrc)+length(CurSrc)
|
|
else
|
|
EndP:=@CurSrc[p];
|
|
while (sp<EndP) do begin
|
|
if IsIdentStartChar[sp^] then begin
|
|
CurName:=GetIdentifier(sp);
|
|
if (CompareIdentifiers(sp,'defined')<>0)
|
|
and (CompareIdentifiers(sp,'undefined')<>0) then begin
|
|
if not Macros.Contains(CurName) then begin
|
|
Macros[CurName]:='';
|
|
end;
|
|
end;
|
|
inc(sp,length(CurName));
|
|
end else begin
|
|
inc(sp);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
CodeBufs:=nil;
|
|
Macros:=TStringToStringTree.Create(false);
|
|
try
|
|
Add(Scanner.InitialValues);
|
|
Add(Scanner.Values);
|
|
if (Directive='if') or (Directive='elseif')
|
|
or (Directive='ifc') or (Directive='elifc') then begin
|
|
AddCompilerFunction('defined','','boolean');
|
|
AddCompilerFunction('undefined','','boolean');
|
|
end;
|
|
|
|
// add all words of all directives in unit
|
|
CodeBufs:=Scanner.CreateTreeOfSourceCodes;
|
|
AVLNode:=CodeBufs.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
AddExprWords(TCodeBuffer(AVLNode.Data));
|
|
AVLNode:=CodeBufs.FindSuccessor(AVLNode);
|
|
end;
|
|
|
|
for StrItem in Macros do
|
|
AddKeyWord(StrItem^.Name);
|
|
finally
|
|
CodeBufs.Free;
|
|
Macros.Free;
|
|
end;
|
|
end;
|
|
|
|
function TIdentCompletionTool.GatherAvailableUnitNames(const CursorPos: TCodeXYPosition;
|
|
var IdentifierList: TIdentifierList): Boolean;
|
|
begin
|
|
Result:=false;
|
|
|
|
try
|
|
InitCollectIdentifiers(CursorPos, IdentifierList);
|
|
|
|
GatherUnitNames;
|
|
Result:=true;
|
|
|
|
finally
|
|
CurrentIdentifierList:=nil;
|
|
end;
|
|
end;
|
|
|
|
function TIdentCompletionTool.GatherIdentifiers(
|
|
const CursorPos: TCodeXYPosition; var IdentifierList: TIdentifierList
|
|
): boolean;
|
|
var
|
|
CleanCursorPos, IdentStartPos, IdentEndPos: integer;
|
|
CursorNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams;
|
|
GatherContext: TFindContext;
|
|
ContextExprStartPos: Integer;
|
|
StartInSubContext: Boolean;
|
|
StartPosOfVariable: LongInt;
|
|
CursorContext: TFindContext;
|
|
IdentStartXY: TCodeXYPosition;
|
|
InFrontOfDirective, HasInheritedKeyword: Boolean;
|
|
ExprType: TExpressionType;
|
|
IdentifierPath: string;
|
|
|
|
procedure CheckProcedureDeclarationContext;
|
|
var
|
|
Node: TCodeTreeNode;
|
|
Can: Boolean;
|
|
begin
|
|
//DebugLn(['CheckProcedureDeclarationContext ',CursorNode.DescAsString]);
|
|
Node:=CursorNode;
|
|
Can:=false;
|
|
if (Node.Parent<>nil)
|
|
and (Node.Parent.Desc in AllClassSections)
|
|
and (Node.Desc=ctnVarDefinition)
|
|
and (CurrentIdentifierList.StartAtomBehind.Flag<>cafColon) then begin
|
|
{ cursor is at a class variable definition without type
|
|
for example:
|
|
|
|
public
|
|
MouseM|
|
|
end;
|
|
}
|
|
Can:=true;
|
|
end
|
|
else if (((Node.Desc=ctnProcedure) and (not NodeIsMethodBody(Node)))
|
|
or ((Node.Desc=ctnProcedureHead) and (not NodeIsMethodBody(Node.Parent))))
|
|
and (not (CurrentIdentifierList.StartAtomBehind.Flag
|
|
in [cafEdgedBracketOpen,cafRoundBracketOpen]))
|
|
then begin
|
|
// for example: procedure DoSomething|
|
|
Can:=true;
|
|
end
|
|
else if Node.Desc in (AllClassBaseSections+AllSourceTypes
|
|
+[ctnInterface,ctnImplementation])
|
|
then begin
|
|
//DebugLn(['TIdentCompletionTool.CheckProcedureDeclarationContext ilcfCanProcDeclaration']);
|
|
Can:=true;
|
|
end;
|
|
if Can then
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfCanProcDeclaration];
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
|
|
ActivateGlobalWriteLock;
|
|
try
|
|
InitCollectIdentifiers(CursorPos,IdentifierList);
|
|
IdentStartXY:=FindIdentifierStartPos(CursorPos);
|
|
if CheckCursorInCompilerDirective(IdentStartXY) then exit(true);
|
|
|
|
ParseSourceTillCollectionStart(IdentStartXY,CleanCursorPos,CursorNode,
|
|
IdentStartPos,IdentEndPos);
|
|
Params:=TFindDeclarationParams.Create(Self,CursorNode);
|
|
try
|
|
if CleanCursorPos=0 then ;
|
|
if IdentStartPos>0 then begin
|
|
MoveCursorToCleanPos(IdentStartPos);
|
|
ReadNextAtom;
|
|
CurrentIdentifierList.StartAtom:=CurPos;
|
|
end;
|
|
|
|
MoveCursorToCleanPos(IdentStartPos);
|
|
ReadPriorAtom;
|
|
IdentifierPath := '';
|
|
while CurPos.Flag = cafPoint do
|
|
begin
|
|
ReadPriorAtom;
|
|
if CurPos.Flag <> cafWord then
|
|
Break;
|
|
IdentifierPath := GetUpAtom + '.' + IdentifierPath;
|
|
ReadPriorAtom;
|
|
end;
|
|
|
|
// find context
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TIdentCompletionTool.GatherIdentifiers B',
|
|
' CleanCursorPos=',CleanPosToStr(CleanCursorPos),
|
|
' IdentStartPos=',CleanPosToStr(IdentStartPos),' IdentEndPos=',CleanPosToStr(IdentEndPos),
|
|
' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos));
|
|
{$ENDIF}
|
|
GatherContext:=CreateFindContext(Self,CursorNode);
|
|
CurrentIdentifierList.NewMemberVisibility:=GetClassVisibility(CursorNode);
|
|
if CursorNode.Desc in [ctnUsesSection,ctnUseUnit,ctnUseUnitNamespace,ctnUseUnitClearName] then begin
|
|
GatherUnitNames(IdentifierPath);
|
|
MoveCursorToCleanPos(IdentEndPos);
|
|
ReadNextAtom;
|
|
if (CurPos.Flag=cafWord) and (not UpAtomIs('IN')) then begin
|
|
// add comma
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfNeedsEndComma];
|
|
end;
|
|
end else if (CursorNode.Desc in AllSourceTypes)
|
|
and (PositionsInSameLine(Src,CursorNode.StartPos,IdentStartPos)) then begin
|
|
GatherSourceNames(GatherContext);
|
|
end else begin
|
|
FindCollectionContext(Params,IdentStartPos,CursorNode,
|
|
ExprType,ContextExprStartPos,StartInSubContext,
|
|
HasInheritedKeyword);
|
|
//debugln(['TIdentCompletionTool.GatherIdentifiers FindCollectionContext ',ExprTypeToString(ExprType)]);
|
|
|
|
GatherContext := ExprType.Context;
|
|
if GatherContext.Node<>nil then
|
|
DebugLn('%d:%d', [GatherContext.Node.StartPos, GatherContext.Node.EndPos]);
|
|
// find class and ancestors if existing (needed for protected identifiers)
|
|
if (GatherContext.Tool = Self) or HasInheritedKeyword then
|
|
begin
|
|
FindContextClassAndAncestorsAndExtendedClassOfHelper(IdentStartXY, FICTClassAndAncestorsAndExtClassOfHelper);
|
|
end;
|
|
|
|
CursorContext:=CreateFindContext(Self,CursorNode);
|
|
GatherContextKeywords(CursorContext,IdentStartPos,Beautifier);
|
|
|
|
// check for incomplete context
|
|
|
|
// context bracket level
|
|
CurrentIdentifierList.StartBracketLvl:=
|
|
GetBracketLvl(Src,CursorNode.StartPos,IdentStartPos,
|
|
Scanner.NestedComments);
|
|
if CursorNode.Desc in AllPascalStatements then begin
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfStartInStatement];
|
|
end;
|
|
|
|
// context in front of
|
|
StartPosOfVariable:=FindStartOfTerm(IdentStartPos,NodeTermInType(CursorNode));
|
|
if StartPosOfVariable>0 then begin
|
|
if StartPosOfVariable=IdentStartPos then begin
|
|
// cursor is at start of an operand
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfStartOfOperand];
|
|
end else begin
|
|
MoveCursorToCleanPos(IdentStartPos);
|
|
ReadPriorAtom;
|
|
if CurPos.Flag=cafPoint then
|
|
// cursor is behind a point
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfStartIsSubIdent];
|
|
end;
|
|
MoveCursorToCleanPos(StartPosOfVariable);
|
|
ReadPriorAtom;
|
|
CurrentIdentifierList.StartAtomInFront:=CurPos;
|
|
if (ilcfStartInStatement in CurrentIdentifierList.ContextFlags)
|
|
then begin
|
|
// check if LValue
|
|
if (CurPos.Flag in [cafSemicolon,cafEnd,cafColon])
|
|
or UpAtomIs('BEGIN')
|
|
or UpAtomIs('TRY') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
|
|
or UpAtomIs('FOR') or UpAtomIs('DO') or UpAtomIs('THEN')
|
|
or UpAtomIs('REPEAT') or UpAtomIs('ASM') or UpAtomIs('ELSE')
|
|
then begin
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfStartOfStatement];
|
|
end;
|
|
// check if expression
|
|
if UpAtomIs('IF') or UpAtomIs('CASE') or UpAtomIs('WHILE')
|
|
or UpAtomIs('UNTIL')
|
|
then begin
|
|
// todo: check at start of expression, not only in front of variable
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfIsExpression, ilcfDontAllowProcedures];
|
|
end;
|
|
// check if procedure is allowed
|
|
if (CurPos.Flag in [cafComma, cafRoundBracketOpen, cafEdgedBracketOpen, cafEqual, cafOtherOperator])
|
|
or ((Scanner.CompilerMode<>cmDelphi) and (CurPos.Flag = cafAssignment)) // "MyEvent := MyProc;" is supported only in Delphi mode
|
|
then
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfDontAllowProcedures];
|
|
end;
|
|
end;
|
|
// context behind
|
|
if (IdentEndPos<SrcLen) then begin
|
|
MoveCursorToCleanPos(IdentEndPos);
|
|
//debugln(['TIdentCompletionTool.GatherIdentifiers "',dbgstr(Src,IdentStartPos,IdentEndPos-IdentStartPos),'"']);
|
|
InFrontOfDirective:=(CurPos.StartPos<SrcLen) and (Src[CurPos.StartPos]='{')
|
|
and (Src[CurPos.StartPos+1]='$');
|
|
ReadNextAtom;
|
|
|
|
// check end of line
|
|
if (not InFrontOfDirective)
|
|
and (CursorPos.Code.LineColIsOutside(CursorPos.Y,CursorPos.X)
|
|
or (not PositionsInSameLine(Src,IdentEndPos,CurPos.StartPos)))
|
|
then
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfEndOfLine];
|
|
|
|
CurrentIdentifierList.StartAtomBehind:=CurPos;
|
|
// check if a semicolon is needed or forbidden at the end
|
|
if InFrontOfDirective
|
|
or (CurrentIdentifierList.StartBracketLvl>0)
|
|
or (CurPos.Flag in [cafSemicolon, cafEqual, cafColon, cafComma,
|
|
cafPoint, cafRoundBracketOpen, cafRoundBracketClose,
|
|
cafEdgedBracketOpen, cafEdgedBracketClose])
|
|
or ((CurPos.Flag in [cafWord,cafNone])
|
|
and (UpAtomIs('ELSE')
|
|
or UpAtomIs('THEN')
|
|
or UpAtomIs('DO')
|
|
or UpAtomIs('TO')
|
|
or UpAtomIs('OF')
|
|
or WordIsBinaryOperator.DoItCaseInsensitive(Src,
|
|
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)))
|
|
then begin
|
|
// do not add semicolon
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfNoEndSemicolon];
|
|
end;
|
|
// check if in statement
|
|
if (ilcfStartInStatement in CurrentIdentifierList.ContextFlags) then
|
|
begin
|
|
// check if a semicolon is needed at the end
|
|
if (not (ilcfNoEndSemicolon in CurrentIdentifierList.ContextFlags))
|
|
then begin
|
|
// check if a semicolon is needed at the end
|
|
if (CurPos.Flag in [cafEnd])
|
|
or WordIsBlockKeyWord.DoItCaseInsensitive(Src,
|
|
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
|
|
or ((CurPos.Flag=cafWord)
|
|
and (not PositionsInSameLine(Src,IdentEndPos,CurPos.StartPos)))
|
|
then begin
|
|
// add semicolon
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfNeedsEndSemicolon];
|
|
end;
|
|
end;
|
|
end;
|
|
// check missing 'do' after 'with'
|
|
if CurrentIdentifierList.StartUpAtomInFrontIs('WITH')
|
|
and (not CurrentIdentifierList.StartUpAtomBehindIs('DO'))
|
|
and (CurrentIdentifierList.StartBracketLvl=0)
|
|
and (not (CurrentIdentifierList.StartAtomBehind.Flag in
|
|
[cafComma,cafPoint,cafRoundBracketOpen,cafEdgedBracketOpen]))
|
|
and (not CurrentIdentifierList.StartUpAtomBehindIs('^'))
|
|
then
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfNeedsDo];
|
|
end else begin
|
|
// end of source
|
|
CurrentIdentifierList.ContextFlags:=
|
|
CurrentIdentifierList.ContextFlags+[ilcfEndOfLine];
|
|
end;
|
|
|
|
// search and gather identifiers in context
|
|
if (GatherContext.Tool<>nil) and (GatherContext.Node<>nil) then begin
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TIdentCompletionTool.GatherIdentifiers D CONTEXT: ',
|
|
GatherContext.Tool.MainFilename,
|
|
' ',GatherContext.Node.DescAsString,
|
|
' "',StringToPascalConst(copy(GatherContext.Tool.Src,GatherContext.Node.StartPos,50)),'"');
|
|
{$ENDIF}
|
|
|
|
// gather all identifiers in context
|
|
Params.ContextNode:=GatherContext.Node;
|
|
Params.SetIdentifier(Self,nil,@CollectAllIdentifiers);
|
|
Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable,fdfSearchInHelpers];
|
|
if (Params.ContextNode.Desc=ctnInterface) and StartInSubContext then
|
|
Include(Params.Flags,fdfIgnoreUsedUnits);
|
|
if not StartInSubContext then
|
|
Include(Params.Flags,fdfSearchInParentNodes);
|
|
if Params.ContextNode.Desc in AllClasses then
|
|
Exclude(Params.Flags,fdfSearchInParentNodes);
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TIdentCompletionTool.GatherIdentifiers F');
|
|
{$ENDIF}
|
|
CurrentIdentifierList.Context:=GatherContext;
|
|
if GatherContext.Node.Desc=ctnIdentifier then
|
|
Params.Flags:=Params.Flags+[fdfIgnoreCurContextNode];
|
|
GatherContext.Tool.FindIdentifierInContext(Params);
|
|
end else
|
|
if ExprType.Desc in xtAllTypeHelperTypes then
|
|
begin
|
|
// gather all identifiers in cursor context for basic types (strings etc.)
|
|
Params.ContextNode:=CursorNode;
|
|
Params.SetIdentifier(Self,nil,@CollectAllIdentifiers);
|
|
Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable,fdfSearchInHelpers];
|
|
CurrentIdentifierList.Context:=CursorContext;
|
|
FindIdentifierInBasicTypeHelpers(ExprType.Desc, Params);
|
|
end;
|
|
|
|
// check for procedure/method declaration context
|
|
CheckProcedureDeclarationContext;
|
|
|
|
// add useful identifiers
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TIdentCompletionTool.GatherIdentifiers G');
|
|
{$ENDIF}
|
|
GatherUsefulIdentifiers(IdentStartPos,CursorContext,GatherContext);
|
|
end;
|
|
|
|
Result:=true;
|
|
finally
|
|
FreeListOfPFindContext(FICTClassAndAncestorsAndExtClassOfHelper);
|
|
FreeAndNil(FIDCTFoundPublicProperties);
|
|
Params.Free;
|
|
ClearIgnoreErrorAfter;
|
|
end;
|
|
finally
|
|
DeactivateGlobalWriteLock;
|
|
CurrentIdentifierList:=nil;
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
DebugLn('TIdentCompletionTool.GatherIdentifiers END');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdentCompletionTool.FindCodeContext(const CursorPos: TCodeXYPosition;
|
|
out CodeContexts: TCodeContextInfo): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
CursorNode: TCodeTreeNode;
|
|
Params: TFindDeclarationParams;
|
|
|
|
procedure AddPredefinedProcs(CurrentContexts: TCodeContextInfo;
|
|
ProcNameAtom: TAtomPosition);
|
|
|
|
procedure AddCompilerProc(const AProcName: string;
|
|
const Params: string; const ResultType: string = '');
|
|
var
|
|
i: LongInt;
|
|
Item: TCodeContextInfoItem;
|
|
begin
|
|
if CompareIdentifiers(PChar(AProcName),@Src[ProcNameAtom.StartPos])<>0
|
|
then exit;
|
|
i:=CurrentContexts.AddCompilerProc;
|
|
Item:=CurrentContexts[i];
|
|
Item.ProcName:=AProcName;
|
|
Item.ResultType:=ResultType;
|
|
Item.Params:=TStringList.Create;
|
|
Item.Params.Delimiter:=';';
|
|
Item.Params.StrictDelimiter:=true;
|
|
Item.Params.DelimitedText:=Params;
|
|
end;
|
|
|
|
var
|
|
IsPointedSystem: Boolean = False;
|
|
begin
|
|
MoveCursorToAtomPos(ProcNameAtom);
|
|
ReadPriorAtom;
|
|
if (CurPos.Flag = cafPoint) then
|
|
begin
|
|
ReadPriorAtom;
|
|
IsPointedSystem := UpAtomIs('SYSTEM');
|
|
end;
|
|
if (CurPos.Flag in [cafEnd,cafSemicolon,cafEqual,cafComma,cafColon,
|
|
cafRoundBracketOpen,cafEdgedBracketOpen,cafAssignment,cafOtherOperator])
|
|
or IsPointedSystem
|
|
or UpAtomIs('BEGIN')
|
|
or UpAtomIs('TRY') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
|
|
or UpAtomIs('ASM')
|
|
or UpAtomIs('REPEAT') or UpAtomIs('UNTIL') or UpAtomIs('WHILE') or UpAtomIs('DO')
|
|
or UpAtomIs('IF') or UpAtomIs('THEN') or UpAtomIs('ELSE')
|
|
then begin
|
|
// see fpc/compiler/psystem.pp
|
|
AddCompilerProc('Assert','Condition:Boolean;const Message:String');
|
|
AddCompilerProc('Assigned','P:Pointer','Boolean');
|
|
AddCompilerProc('Addr','var X','Pointer');
|
|
AddCompilerProc('BitSizeOf','Identifier','Integer');
|
|
AddCompilerProc('Concat','S1:String;S2:String[...;Sn:String]', 'String');
|
|
if StrToIntDef(Scanner.Values['FPC_FULLVERSION'],0)>=30100 then // FromPosition and Count parameters are optional
|
|
AddCompilerProc('Copy','const S:StringOrArray[;FromPosition,Count:Integer]', 'String')
|
|
else
|
|
AddCompilerProc('Copy','const S:StringOrArray;FromPosition,Count:Integer', 'String');
|
|
AddCompilerProc('Dec','var X:Ordinal;N:Integer=1');
|
|
AddCompilerProc('Default','T:Type','const');
|
|
AddCompilerProc('Dispose','var X:Pointer');
|
|
AddCompilerProc('Exclude','var S:Set;X:Ordinal');
|
|
AddCompilerProc('Exit','ResultValue:Ordinal=Result');
|
|
AddCompilerProc('Finalize','var X');
|
|
AddCompilerProc('get_frame','','Pointer');
|
|
AddCompilerProc('High','Arg:TypeOrVariable','Ordinal');
|
|
if StrToIntDef(Scanner.Values['FPC_FULLVERSION'],0)>=30100 then //Delete and Insert are available as intrinsic since FPC 3.1
|
|
begin
|
|
AddCompilerProc('Delete','var S:string;Index,Count:Integer');
|
|
AddCompilerProc('Insert','const Source:string;var Dest:string;Index:Integer');
|
|
end;
|
|
AddCompilerProc('Inc','var X:Ordinal;N:Integer=1');
|
|
AddCompilerProc('Include','var S:Set;X:Ordinal');
|
|
AddCompilerProc('Initialize','var X');
|
|
AddCompilerProc('Length','S:String','Integer');
|
|
AddCompilerProc('Length','A:Array','Integer');
|
|
AddCompilerProc('Low','Arg:TypeOrVariable','Ordinal');
|
|
AddCompilerProc('New','var X:Pointer');
|
|
AddCompilerProc('Ofs','var X','LongInt');
|
|
AddCompilerProc('Ord','X:Ordinal', 'Integer');
|
|
AddCompilerProc('Pack','A:Array;N:Integer;var A:Array');
|
|
AddCompilerProc('Pred','X:Ordinal', 'Ordinal');
|
|
AddCompilerProc('Read','');
|
|
AddCompilerProc('ReadLn','');
|
|
AddCompilerProc('ReadStr','S:String;var Args:Arguments');
|
|
AddCompilerProc('Seg','var X','LongInt');
|
|
AddCompilerProc('SetLength','var S:String;NewLength:Integer');
|
|
AddCompilerProc('SetLength','var A:Array;NewLength:Integer');
|
|
if Scanner.Values.IsDefined('FPC_HAS_CPSTRING') then
|
|
AddCompilerProc('SetString','out S:RawByteString;Buf:PAnsiChar;Len:SizeInt');
|
|
AddCompilerProc('SizeOf','Identifier','Integer');
|
|
AddCompilerProc('Slice','var A:Array;Count:Integer','Array');
|
|
AddCompilerProc('Str','const X[:Width[:Decimals]];var S:String');
|
|
AddCompilerProc('Succ','X:Ordinal', 'Ordinal');
|
|
AddCompilerProc('TypeInfo','Identifier', 'Pointer');
|
|
AddCompilerProc('TypeOf','Identifier', 'Pointer');
|
|
AddCompilerProc('Val','S:String;var V;var Code:Integer');
|
|
AddCompilerProc('Unaligned','var X','var');
|
|
AddCompilerProc('Unpack','A:Array;var A:Array;N:Integer');
|
|
AddCompilerProc('Write','Args:Arguments');
|
|
AddCompilerProc('WriteLn','Args:Arguments');
|
|
AddCompilerProc('WriteStr','var S:String;Args:Arguments');
|
|
end;
|
|
end;
|
|
|
|
function CheckContextIsParameter(var Ok: boolean): boolean;
|
|
// returns true, on error or context is parameter
|
|
var
|
|
VarNameAtom, ProcNameAtom: TAtomPosition;
|
|
ParameterIndex: integer;
|
|
ContextExprStartPos: LongInt;
|
|
StartInSubContext, HasInheritedKeyword: Boolean;
|
|
ExprType: TExpressionType;
|
|
begin
|
|
Result:=false;
|
|
// check if in a begin..end block
|
|
if CursorNode.GetNodeOfTypes([ctnBeginBlock,ctnInitialization,ctnFinalization])=nil
|
|
then begin
|
|
DebugLn(['TIdentCompletionTool.FindCodeContext.CheckContextIsParameter not in a begin block']);
|
|
exit;
|
|
end;
|
|
// check if cursor is in a parameter list
|
|
if not CheckParameterSyntax(CursorNode.StartPos, CleanCursorPos,
|
|
VarNameAtom, ProcNameAtom, ParameterIndex)
|
|
then begin
|
|
if VarNameAtom.StartPos=0 then ;
|
|
DebugLn(['TIdentCompletionTool.FindCodeContext.CheckContextIsParameter not in a parameter list']);
|
|
exit;
|
|
end;
|
|
//DebugLn('CheckContextIsParameter Variable=',GetAtom(VarNameAtom),' Proc=',GetAtom(ProcNameAtom),' ParameterIndex=',dbgs(ParameterIndex));
|
|
|
|
// it is a parameter -> create context
|
|
Result:=true;
|
|
if CurrentIdentifierContexts=nil then
|
|
CurrentIdentifierContexts:=TCodeContextInfo.Create;
|
|
CurrentIdentifierContexts.Tool:=Self;
|
|
CurrentIdentifierContexts.ParameterIndex:=ParameterIndex+1;
|
|
CurrentIdentifierContexts.ProcNameAtom:=ProcNameAtom;
|
|
CurrentIdentifierContexts.ProcName:=GetAtom(ProcNameAtom);
|
|
|
|
AddPredefinedProcs(CurrentIdentifierContexts,ProcNameAtom);
|
|
|
|
MoveCursorToAtomPos(ProcNameAtom);
|
|
ReadNextAtom; // read opening bracket
|
|
CurrentIdentifierContexts.StartPos:=CurPos.EndPos;
|
|
// read closing bracket
|
|
if ReadTilBracketClose(false) then
|
|
CurrentIdentifierContexts.EndPos:=CurPos.StartPos
|
|
else
|
|
CurrentIdentifierContexts.EndPos:=SrcLen+1;
|
|
|
|
FindCollectionContext(Params,ProcNameAtom.StartPos,CursorNode,
|
|
ExprType,ContextExprStartPos,StartInSubContext,
|
|
HasInheritedKeyword);
|
|
|
|
if ContextExprStartPos=0 then ;
|
|
{$IFDEF VerboseCodeContext}
|
|
DebugLn(['CheckContextIsParameter StartInSubContext=',StartInSubContext,' ',ExprType.Context.Node.DescAsString,' "',copy(ExprType.Context.Tool.Src,GatherContext.Node.StartPos-20,25),'"']);
|
|
{$ENDIF}
|
|
|
|
// gather declarations of all parameter lists
|
|
if (ExprType.Context.Node = nil) or (ExprType.Context.Tool = nil) then
|
|
begin
|
|
if ExprType.Desc in xtAllIdentPredefinedTypes then
|
|
begin
|
|
ExprType.Context.Node := CursorNode;
|
|
ExprType.Context.Tool := Self;
|
|
end else
|
|
Exit;
|
|
end;
|
|
|
|
Params.ContextNode:=ExprType.Context.Node;
|
|
Params.SetIdentifier(Self,@Src[ProcNameAtom.StartPos],@CollectAllContexts);
|
|
Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable,fdfSearchInHelpers];
|
|
if not StartInSubContext then
|
|
Include(Params.Flags,fdfSearchInParentNodes);
|
|
CurrentIdentifierList.Context:=ExprType.Context;
|
|
{$IFDEF VerboseCodeContext}
|
|
DebugLn('CheckContextIsParameter searching procedures, properties and variables ...');
|
|
{$ENDIF}
|
|
if ExprType.Desc in xtAllTypeHelperTypes then
|
|
ExprType.Context.Tool.FindIdentifierInBasicTypeHelpers(ExprType.Desc, Params)
|
|
else
|
|
ExprType.Context.Tool.FindIdentifierInContext(Params);
|
|
{$IFDEF VerboseCodeContext}
|
|
DebugLn('CheckContextIsParameter END');
|
|
{$ENDIF}
|
|
Ok:=true;
|
|
end;
|
|
|
|
var
|
|
IdentifierList: TIdentifierList;
|
|
IdentStartPos, IdentEndPos: integer;
|
|
begin
|
|
CodeContexts:=nil;
|
|
Result:=false;
|
|
|
|
IdentifierList:=nil;
|
|
CurrentIdentifierContexts:=CodeContexts;
|
|
|
|
ActivateGlobalWriteLock;
|
|
try
|
|
InitCollectIdentifiers(CursorPos,IdentifierList);
|
|
ParseSourceTillCollectionStart(CursorPos,CleanCursorPos,CursorNode,
|
|
IdentStartPos,IdentEndPos);
|
|
Params:=TFindDeclarationParams.Create(Self, CursorNode);
|
|
try
|
|
if IdentStartPos=0 then ;
|
|
if IdentEndPos=0 then ;
|
|
|
|
// find class and ancestors if existing (needed for protected identifiers)
|
|
FindContextClassAndAncestorsAndExtendedClassOfHelper(CursorPos,FICTClassAndAncestorsAndExtClassOfHelper);
|
|
|
|
if CursorNode<>nil then begin
|
|
if not CheckContextIsParameter(Result) then begin
|
|
DebugLn(['TIdentCompletionTool.FindCodeContext cursor not at parameter']);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if CurrentIdentifierContexts=nil then begin
|
|
// create default
|
|
AddCollectionContext(Self,CursorNode);
|
|
end;
|
|
|
|
Result:=true;
|
|
finally
|
|
if Result then begin
|
|
CodeContexts:=CurrentIdentifierContexts;
|
|
CurrentIdentifierContexts:=nil;
|
|
end else begin
|
|
FreeAndNil(CurrentIdentifierContexts);
|
|
end;
|
|
FreeListOfPFindContext(FICTClassAndAncestorsAndExtClassOfHelper);
|
|
FreeAndNil(FIDCTFoundPublicProperties);
|
|
Params.Free;
|
|
ClearIgnoreErrorAfter;
|
|
end;
|
|
finally
|
|
DeactivateGlobalWriteLock;
|
|
FreeAndNil(CurrentIdentifierList);
|
|
end;
|
|
end;
|
|
|
|
function TIdentCompletionTool.FindAbstractMethods(
|
|
const CursorPos: TCodeXYPosition; out ListOfPCodeXYPosition: TFPList;
|
|
SkipAbstractsInStartClass: boolean): boolean;
|
|
const
|
|
ProcAttr = [phpWithoutClassKeyword,phpWithHasDefaultValues];
|
|
FlagIsAbstract = 0;
|
|
FlagIsImplemented = 1;
|
|
var
|
|
ImplementedInterfaces: TStringToPointerTree;
|
|
SearchedAncestors: TAVLTree;
|
|
Procs: TAVLTree; // tree of TCodeTreeNodeExtension
|
|
|
|
procedure AddProc(ATool: TFindDeclarationTool; ProcNode: TCodeTreeNode;
|
|
IsAbstract: boolean);
|
|
var
|
|
ProcText: String;
|
|
AVLNode: TAVLTreeNode;
|
|
NodeExt: TCodeTreeNodeExtension;
|
|
begin
|
|
ProcText:=ATool.ExtractProcHead(ProcNode,ProcAttr);
|
|
AVLNode:=FindCodeTreeNodeExtAVLNode(Procs,ProcText);
|
|
if AVLNode<>nil then begin
|
|
// known proc
|
|
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
|
|
//debugln(['AddProc "',ProcText,'" WasImplemented=',NodeExt.Flags=1,' IsAbstract=',IsAbstract]);
|
|
if NodeExt.Flags=FlagIsImplemented then
|
|
exit; // already implemented
|
|
if IsAbstract then
|
|
exit; // already abstract
|
|
NodeExt.Flags:=FlagIsImplemented;
|
|
NodeExt.Node:=ProcNode;
|
|
NodeExt.Data:=ATool;
|
|
end else begin
|
|
// new method
|
|
//debugln(['AddProc "',ProcText,'" New IsAbstract=',IsAbstract]);
|
|
NodeExt:=TCodeTreeNodeExtension.Create;
|
|
NodeExt.Node:=ProcNode;
|
|
NodeExt.Data:=ATool;
|
|
NodeExt.Txt:=ProcText;
|
|
if IsAbstract then
|
|
NodeExt.Flags:=FlagIsAbstract
|
|
else
|
|
NodeExt.Flags:=FlagIsImplemented;
|
|
Procs.Add(NodeExt);
|
|
end;
|
|
end;
|
|
|
|
procedure CollectImplements(ClassNode: TCodeTreeNode);
|
|
var
|
|
Node: TCodeTreeNode;
|
|
StopNode: TCodeTreeNode;
|
|
InterfaceName: String;
|
|
begin
|
|
Node:=ClassNode.FirstChild;
|
|
StopNode:=ClassNode.NextSkipChilds;
|
|
while Node<>StopNode do begin
|
|
if Node.Desc in AllClassBaseSections then begin
|
|
Node:=Node.Next;
|
|
continue;
|
|
end else if Node.Desc=ctnProperty then begin
|
|
if PropertyHasSpecifier(Node,'IMPLEMENTS',false) then begin
|
|
ReadNextAtom;
|
|
while AtomIsIdentifier do begin
|
|
InterfaceName:=GetAtom;
|
|
ReadNextAtom;
|
|
if CurPos.Flag=cafPoint then begin
|
|
ReadNextAtom;
|
|
AtomIsIdentifierE(true);
|
|
InterfaceName+='.'+GetAtom;
|
|
ReadNextAtom;
|
|
end;
|
|
//debugln(['CollectImplements ',InterfaceName]);
|
|
ImplementedInterfaces[InterfaceName]:=Node;
|
|
if CurPos.Flag<>cafComma then break;
|
|
ReadNextAtom;
|
|
end;
|
|
end;
|
|
end else if Node.Desc=ctnProcedure then begin
|
|
if ProcNodeHasSpecifier(Node,psABSTRACT) then begin
|
|
if not SkipAbstractsInStartClass then
|
|
AddProc(Self,Node,true);
|
|
end else begin
|
|
AddProc(Self,Node,false);
|
|
end;
|
|
end;
|
|
Node:=Node.NextSkipChilds;
|
|
end;
|
|
end;
|
|
|
|
procedure CollectAncestors(aTool: TFindDeclarationTool;
|
|
ClassNode: TCodeTreeNode; IsStartClass: boolean); forward;
|
|
|
|
procedure CollectAncestor(ATool: TFindDeclarationTool;
|
|
InheritanceNode: TCodeTreeNode; SearchedAncestors: TAVLTree;
|
|
IsStartClass: boolean);
|
|
var
|
|
Params: TFindDeclarationParams;
|
|
ClassNode: TCodeTreeNode;
|
|
StopNode: TCodeTreeNode;
|
|
Node: TCodeTreeNode;
|
|
IsInterface: Boolean;
|
|
begin
|
|
//debugln(['CollectAncestor Ancestor=',ATool.ExtractIdentifierWithPoints(InheritanceNode.StartPos,false)]);
|
|
Params:=TFindDeclarationParams.Create;
|
|
try
|
|
if not ATool.FindAncestorOfClassInheritance(InheritanceNode,Params,true)
|
|
then exit;
|
|
ATool:=Params.NewCodeTool;
|
|
ClassNode:=Params.NewNode;
|
|
if SearchedAncestors.Find(ClassNode)<>nil then
|
|
exit; // already searched
|
|
SearchedAncestors.Add(ClassNode);
|
|
// check all procs of this ancestor
|
|
StopNode:=ClassNode.NextSkipChilds;
|
|
Node:=ClassNode.FirstChild;
|
|
IsInterface:=ClassNode.Desc in AllClassInterfaces;
|
|
if IsInterface and (not IsStartClass) then
|
|
exit;
|
|
while Node<>StopNode do begin
|
|
if Node.Desc in AllClassBaseSections then begin
|
|
Node:=Node.Next;
|
|
continue;
|
|
end else if Node.Desc=ctnProcedure then begin
|
|
if IsInterface
|
|
or ATool.ProcNodeHasSpecifier(Node,psABSTRACT) then
|
|
AddProc(ATool,Node,true)
|
|
else
|
|
AddProc(ATool,Node,false);
|
|
end;
|
|
Node:=Node.NextSkipChilds;
|
|
end;
|
|
CollectAncestors(ATool,ClassNode,false);
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure CollectAncestors(aTool: TFindDeclarationTool;
|
|
ClassNode: TCodeTreeNode; IsStartClass: boolean);
|
|
var
|
|
InheritanceNode: TCodeTreeNode;
|
|
AncestorName: String;
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
//debugln(['CollectAncestors of Class=',aTool.ExtractClassName(ClassNode,false)]);
|
|
InheritanceNode:=ATool.FindInheritanceNode(ClassNode);
|
|
if (InheritanceNode=nil)
|
|
or (InheritanceNode.FirstChild=nil) then begin
|
|
// no ancestors
|
|
exit;
|
|
end;
|
|
Node:=InheritanceNode.FirstChild;
|
|
while Node<>nil do begin
|
|
InheritanceNode:=Node;
|
|
Node:=Node.NextBrother;
|
|
if InheritanceNode.Desc=ctnIdentifier then begin
|
|
if IsStartClass then begin
|
|
AncestorName:=ATool.ExtractIdentifierWithPoints(InheritanceNode.StartPos,true);
|
|
if ImplementedInterfaces.FindNode(AncestorName)<>nil then
|
|
continue;
|
|
end;
|
|
CollectAncestor(ATool,InheritanceNode,SearchedAncestors,IsStartClass);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
CleanCursorPos: integer;
|
|
CursorNode: TCodeTreeNode;
|
|
ClassNode: TCodeTreeNode;
|
|
AVLNode: TAVLTreeNode;
|
|
NodeExt: TCodeTreeNodeExtension;
|
|
ProcXYPos: TCodeXYPosition;
|
|
ATool: TFindDeclarationTool;
|
|
begin
|
|
Result:=false;
|
|
ListOfPCodeXYPosition:=nil;
|
|
ImplementedInterfaces:=nil;
|
|
Procs:=nil;
|
|
SearchedAncestors:=nil;
|
|
try
|
|
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
|
|
[btSetIgnoreErrorPos]);
|
|
|
|
// find node at position
|
|
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
|
|
|
|
// if cursor is on type node, find class node
|
|
if CursorNode.Desc=ctnTypeDefinition then
|
|
CursorNode:=CursorNode.FirstChild
|
|
else if CursorNode.Desc=ctnGenericType then
|
|
CursorNode:=CursorNode.LastChild
|
|
else
|
|
CursorNode:=FindClassOrInterfaceNode(CursorNode);
|
|
|
|
if (CursorNode=nil)
|
|
or (not (CursorNode.Desc in AllClassObjects))
|
|
or ((CursorNode.SubDesc and ctnsForwardDeclaration)>0) then begin
|
|
MoveCursorToCleanPos(CleanCursorPos);
|
|
RaiseException('TIdentCompletionTool.FindAbstractMethods cursor is not in a class');
|
|
end;
|
|
ClassNode:=CursorNode;
|
|
|
|
// search class for implemented interfaces and method
|
|
ImplementedInterfaces:=TStringToPointerTree.Create(false);
|
|
Procs:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
|
CollectImplements(ClassNode);
|
|
|
|
// search all ancestors
|
|
SearchedAncestors:=TAVLTree.Create;
|
|
SearchedAncestors.Add(ClassNode);
|
|
CollectAncestors(Self,ClassNode,true);
|
|
|
|
// AddCodePosition for each abstract method
|
|
AVLNode:=Procs.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
|
|
if NodeExt.Flags=FlagIsAbstract then begin
|
|
ATool:=TFindDeclarationTool(NodeExt.Data);
|
|
if not ATool.CleanPosToCaret(NodeExt.Node.StartPos,ProcXYPos) then
|
|
raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency');
|
|
AddCodePosition(ListOfPCodeXYPosition,ProcXYPos);
|
|
end;
|
|
AVLNode:=Procs.FindSuccessor(AVLNode);
|
|
end;
|
|
|
|
Result:=true;
|
|
finally
|
|
DisposeAVLTree(Procs);
|
|
ImplementedInterfaces.Free;
|
|
SearchedAncestors.Free;
|
|
end;
|
|
end;
|
|
|
|
function TIdentCompletionTool.GetValuesOfCaseVariable(
|
|
const CursorPos: TCodeXYPosition; List: TStrings): boolean;
|
|
var
|
|
CleanCursorPos: integer;
|
|
CursorNode: TCodeTreeNode;
|
|
CaseAtom: TAtomPosition;
|
|
Params: TFindDeclarationParams;
|
|
EndPos: LongInt;
|
|
ExprType: TExpressionType;
|
|
Node: TCodeTreeNode;
|
|
Tool: TFindDeclarationTool;
|
|
begin
|
|
Result:=false;
|
|
ActivateGlobalWriteLock;
|
|
Params:=nil;
|
|
try
|
|
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
|
|
[btSetIgnoreErrorPos]);
|
|
|
|
// find node at position
|
|
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
|
|
|
|
// find keyword case
|
|
MoveCursorToNodeStart(CursorNode);
|
|
CaseAtom:=CleanAtomPosition;
|
|
repeat
|
|
ReadNextAtom;
|
|
if UpAtomIs('CASE') then
|
|
CaseAtom:=CurPos
|
|
until (CurPos.EndPos>SrcLen) or (CurPos.EndPos>CleanCursorPos);
|
|
if CaseAtom.StartPos<1 then exit;
|
|
|
|
// find case variable
|
|
EndPos:=FindEndOfExpression(CaseAtom.EndPos);
|
|
if EndPos>CleanCursorPos then
|
|
EndPos:=CleanCursorPos;
|
|
//DebugLn(['TIdentCompletionTool.GetValuesOfCaseVariable Expr=',dbgstr(copy(Src,CaseAtom.EndPos,EndPos-CaseAtom.EndPos))]);
|
|
|
|
Params:=TFindDeclarationParams.Create(Self, CursorNode);
|
|
Params.Flags:=fdfDefaultForExpressions+[fdfFunctionResult];
|
|
ExprType:=FindExpressionTypeOfTerm(CaseAtom.EndPos,EndPos,Params,true);
|
|
//DebugLn(['TIdentCompletionTool.GetValuesOfCaseVariable Type=',ExprTypeToString(ExprType)]);
|
|
|
|
if ExprType.Desc=xtContext then begin
|
|
// resolve aliases and properties
|
|
Params.Clear;
|
|
Params.Flags:=fdfDefaultForExpressions;
|
|
ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,
|
|
ExprType.Context.Node);
|
|
end;
|
|
|
|
case ExprType.Desc of
|
|
|
|
xtBoolean,xtByteBool,xtWordBool,xtLongBool,xtQWordBool:
|
|
begin
|
|
List.Add('True');
|
|
List.Add('False');
|
|
end;
|
|
|
|
xtContext:
|
|
begin
|
|
Node:=ExprType.Context.Node;
|
|
Tool:=ExprType.Context.Tool;
|
|
if Node=nil then exit;
|
|
case Node.Desc of
|
|
|
|
ctnEnumerationType:
|
|
begin
|
|
Node:=Node.FirstChild;
|
|
while Node<>nil do begin
|
|
List.Add(GetIdentifier(@Tool.Src[Node.StartPos]));
|
|
Node:=Node.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
else
|
|
debugln(['TIdentCompletionTool.GetValuesOfCaseVariable not an enum: ',Node.DescAsString]);
|
|
exit;
|
|
end;
|
|
end;
|
|
else
|
|
exit;
|
|
end;
|
|
|
|
Result:=true;
|
|
finally
|
|
Params.Free;
|
|
DeactivateGlobalWriteLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentCompletionTool.CalcMemSize(Stats: TCTMemStats);
|
|
var
|
|
Node: TAVLTreeNode;
|
|
Ext: TCodeTreeNodeExtension;
|
|
m: PtrUint;
|
|
begin
|
|
inherited CalcMemSize(Stats);
|
|
if FICTClassAndAncestorsAndExtClassOfHelper<>nil then
|
|
Stats.Add('TIdentCompletionTool.ClassAndAncestorsAndExtClassOfHelper',
|
|
FICTClassAndAncestorsAndExtClassOfHelper.Count*(SizeOf(TAVLTreeNode)+SizeOf(TCodeXYPosition)));
|
|
if FIDCTFoundPublicProperties<>nil then
|
|
Stats.Add('TIdentCompletionTool.FoundPublicProperties',
|
|
FIDCTFoundPublicProperties.Count*SizeOf(TAVLTreeNode));
|
|
if FIDTFoundMethods<>nil then begin
|
|
m:=PtrUint(FIDTFoundMethods.Count)*SizeOf(TAVLTreeNode);
|
|
Node:=FIDTFoundMethods.FindLowest;
|
|
while Node<>nil do begin
|
|
Ext:=TCodeTreeNodeExtension(Node.Data);
|
|
inc(m,Ext.CalcMemSize);
|
|
Node:=FIDTFoundMethods.FindSuccessor(Node);
|
|
end;
|
|
STats.Add('TIdentCompletionTool.FoundMethods',m);
|
|
end;
|
|
if CurrentIdentifierList<>nil then
|
|
Stats.Add('TIdentCompletionTool.CurrentIdentifierList',
|
|
CurrentIdentifierList.CalcMemSize);
|
|
if CurrentIdentifierContexts<>nil then
|
|
Stats.Add('TIdentCompletionTool.CurrentContexts',
|
|
CurrentIdentifierContexts.CalcMemSize);
|
|
end;
|
|
|
|
{ TIdentifierListItem }
|
|
|
|
function TIdentifierListItem.GetParamTypeList: string;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliParamTypeListValid in Flags) then begin
|
|
// Note: if you implement param lists for other than ctnProcedure, check
|
|
// CompareParamList
|
|
ANode:=Node;
|
|
FParamTypeList:='';
|
|
if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
|
|
try
|
|
FParamTypeList:=Tool.ExtractProcHead(ANode,
|
|
[phpWithoutClassKeyword,phpWithoutClassName,
|
|
phpWithoutName,phpInUpperCase]);
|
|
//debugln('TIdentifierListItem.GetParamTypeList A ',GetIdentifier(Identifier),' ',Tool.MainFilename,' ',dbgs(CurNode.StartPos));
|
|
except
|
|
on E: ECodeToolError do ; // ignore syntax errors
|
|
end;
|
|
end;
|
|
Include(Flags,iliParamTypeListValid);
|
|
end;
|
|
Result:=FParamTypeList;
|
|
end;
|
|
|
|
function TIdentifierListItem.GetParamNameList: string;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliParamNameListValid in Flags) then begin
|
|
// Note: if you implement param lists for other than ctnProcedure, check
|
|
// CompareParamList
|
|
ANode:=Node;
|
|
FParamNameList:='';
|
|
if (ANode<>nil) and (ANode.Desc=ctnProcedure) then begin
|
|
try
|
|
FParamNameList:=Tool.ExtractProcHead(ANode,
|
|
[phpWithoutClassKeyword,phpWithoutClassName,
|
|
phpWithoutName,phpInUpperCase,phpWithParameterNames]);
|
|
//debugln('TIdentifierListItem.GetParamNameList A ',GetIdentifier(Identifier),' ',Tool.MainFilename,' ',dbgs(CurNode.StartPos));
|
|
except
|
|
on E: ECodeToolError do ; // ignore syntax errors
|
|
end;
|
|
end;
|
|
Include(Flags,iliParamNameListValid);
|
|
end;
|
|
Result:=FParamNameList;
|
|
end;
|
|
|
|
function TIdentifierListItem.GetNode: TCodeTreeNode;
|
|
begin
|
|
Result:=nil;
|
|
if Tool=nil then
|
|
exit;
|
|
|
|
if (iliNodeValid in Flags)
|
|
and (FToolNodesDeletedStep<>Tool.NodesDeletedChangeStep) then
|
|
Exclude(Flags,iliNodeValid);
|
|
|
|
if (not (iliNodeValid in Flags)) then begin
|
|
if iliNodeHashValid in Flags then begin
|
|
RestoreNode;
|
|
if (iliNodeValid in Flags) then begin
|
|
Result:=FNode;
|
|
end;
|
|
end;
|
|
end else begin
|
|
if FToolNodesDeletedStep=Tool.NodesDeletedChangeStep then begin
|
|
Result:=FNode;
|
|
end else begin
|
|
if not (iliNodeGoneWarned in Flags) then begin
|
|
DebugLn(['TIdentifierListItem.GetNode node ',Identifier,' is gone from ',Tool.MainFilename]);
|
|
Include(Flags,iliNodeGoneWarned);
|
|
end;
|
|
FNode:=nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentifierListItem.SetNode(const AValue: TCodeTreeNode);
|
|
|
|
procedure RaiseToolMissing;
|
|
begin
|
|
raise Exception.Create('TIdentifierListItem.SetNode Node without Tool');
|
|
end;
|
|
|
|
begin
|
|
FNode:=AValue;
|
|
Include(Flags,iliNodeValid);
|
|
Exclude(Flags,iliNodeHashValid);
|
|
if (FNode<>nil) and (Tool=nil) then
|
|
RaiseToolMissing;
|
|
if (Tool<>nil) then
|
|
FToolNodesDeletedStep:=Tool.NodesDeletedChangeStep;
|
|
if (FNode<>nil) then
|
|
StoreNodeHash;
|
|
end;
|
|
|
|
procedure TIdentifierListItem.SetParamTypeList(const AValue: string);
|
|
begin
|
|
FParamTypeList:=AValue;
|
|
Include(Flags,iliParamTypeListValid);
|
|
end;
|
|
|
|
procedure TIdentifierListItem.SetParamNameList(const AValue: string);
|
|
begin
|
|
FParamNameList:=AValue;
|
|
Include(Flags,iliParamNameListValid);
|
|
end;
|
|
|
|
procedure TIdentifierListItem.SetResultType(const AValue: string);
|
|
begin
|
|
FResultType := AValue;
|
|
Include(Flags, iliResultTypeValid);
|
|
end;
|
|
|
|
function TIdentifierListItem.AsString: string;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
WriteStr(Result, Compatibility);
|
|
if HasChilds then
|
|
Result:=Result+' HasChilds'
|
|
else
|
|
Result:=Result+' HasNoChilds';
|
|
Result:=Result+' History='+IntToStr(HistoryIndex);
|
|
Result:=Result+' Ident='+Identifier;
|
|
Result:=Result+' Lvl='+IntToStr(Level);
|
|
if Tool<>nil then
|
|
Result:=Result+' File='+Tool.MainFilename;
|
|
ANode:=Node;
|
|
if ANode<>nil then
|
|
Result:=Result+' Node='+ANode.DescAsString
|
|
+' "'+StringToPascalConst(copy(Tool.Src,ANode.StartPos,50))+'"';
|
|
end;
|
|
|
|
procedure TIdentifierListItem.BeautifyIdentifier(IdentList: TIdentifierList);
|
|
begin
|
|
// can be overridden
|
|
end;
|
|
|
|
function TIdentifierListItem.GetDesc: TCodeTreeNodeDesc;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
ANode:=Node;
|
|
if ANode<>nil then
|
|
Result:=ANode.Desc
|
|
else
|
|
Result:=DefaultDesc;
|
|
end;
|
|
|
|
constructor TIdentifierListItem.Create(
|
|
NewCompatibility: TIdentifierCompatibility; NewHasChilds: boolean;
|
|
NewHistoryIndex: integer; NewIdentifier: PChar; NewLevel: integer;
|
|
NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
|
|
NewDefaultDesc: TCodeTreeNodeDesc);
|
|
begin
|
|
Compatibility:=NewCompatibility;
|
|
if NewHasChilds then Include(FLags,iliHasChilds);
|
|
HistoryIndex:=NewHistoryIndex;
|
|
Identifier:=GetIdentifier(NewIdentifier);
|
|
Level:=NewLevel;
|
|
Tool:=NewTool;
|
|
Node:=NewNode;
|
|
DefaultDesc:=NewDefaultDesc;
|
|
BaseExprType:=CleanExpressionType;
|
|
end;
|
|
|
|
function TIdentifierListItem.IsProcNodeWithParams: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
StartPos: Integer;
|
|
begin
|
|
Result:=(GetDesc=ctnProcedure);
|
|
if not Result then exit;
|
|
if (iliParamNameListValid in Flags) then begin
|
|
StartPos:=1;
|
|
while (StartPos<=length(FParamTypeList))
|
|
and (FParamTypeList[StartPos] in [' ',#9,'(','[']) do
|
|
inc(StartPos);
|
|
if (StartPos<=length(FParamTypeList))
|
|
and (FParamTypeList[StartPos] in [')',']',';']) then
|
|
exit(false)
|
|
else
|
|
exit(true);
|
|
end else if (iliParamTypeListValid in Flags) then begin
|
|
// the type list does not contain names
|
|
// so a () could be empty or (var buf)
|
|
StartPos:=1;
|
|
while (StartPos<=length(FParamTypeList))
|
|
and (FParamTypeList[StartPos] in [' ',#9,'(','[']) do
|
|
inc(StartPos);
|
|
if (StartPos<=length(FParamTypeList))
|
|
and (not (FParamTypeList[StartPos] in [')',']',';'])) then
|
|
exit(true);
|
|
end;
|
|
ANode:=Node;
|
|
Result:=(ANode<>nil) and Tool.ProcNodeHasParamList(ANode);
|
|
end;
|
|
|
|
function TIdentifierListItem.IsPropertyWithParams: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliHasParamListValid in Flags) then begin
|
|
Include(Flags,iliHasParamListValid);
|
|
ANode:=Node;
|
|
if (ANode<>nil) and Tool.PropertyNodeHasParamList(ANode) then
|
|
Include(Flags,iliHasParamList)
|
|
else
|
|
Exclude(Flags,iliHasParamList);
|
|
end;
|
|
Result:=iliHasParamList in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.IsPropertyReadOnly: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliIsReadOnlyValid in Flags) then begin
|
|
Include(Flags,iliIsReadOnlyValid);
|
|
ANode:=Node;
|
|
if (ANode<>nil) and Tool.PropertyHasSpecifier(ANode,'read',false)
|
|
and not Tool.PropertyHasSpecifier(ANode,'write',false) then
|
|
Include(Flags,iliIsReadOnly)
|
|
else
|
|
Exclude(Flags,iliIsReadOnly);
|
|
end;
|
|
Result:=iliIsReadOnly in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.GetHintModifiers: TPascalHintModifiers;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=[];
|
|
if not (iliHintModifiersValid in Flags) then begin
|
|
Include(Flags,iliHintModifiersValid);
|
|
ANode:=Node;
|
|
if ANode<>nil then begin
|
|
Result:=Tool.GetHintModifiers(ANode);
|
|
if phmDeprecated in Result then Include(Flags,iliIsDeprecated);
|
|
if phmPlatform in Result then Include(Flags,iliIsPlatform);
|
|
if phmLibrary in Result then Include(Flags,iliIsLibrary);
|
|
if phmUnimplemented in Result then Include(Flags,iliIsUnimplemented);
|
|
if phmExperimental in Result then Include(Flags,iliIsExperimental);
|
|
end;
|
|
end else begin
|
|
if iliIsDeprecated in Flags then Include(Result,phmDeprecated);
|
|
if iliIsPlatform in Flags then Include(Result,phmPlatform);
|
|
if iliIsLibrary in Flags then Include(Result,phmLibrary);
|
|
if iliIsUnimplemented in Flags then Include(Result,phmUnimplemented);
|
|
if iliIsExperimental in Flags then Include(Result,phmExperimental);
|
|
end;
|
|
end;
|
|
|
|
function TIdentifierListItem.CheckHasChilds: boolean;
|
|
// returns true if test was successful
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if GetDesc in AllClasses then begin
|
|
Result:=true;
|
|
exit;
|
|
end;
|
|
ANode:=Node;
|
|
if ANode=nil then exit;
|
|
UpdateBaseContext;
|
|
if (BaseExprType.Desc=xtContext)
|
|
and (BaseExprType.Context.Node<>nil)
|
|
and (BaseExprType.Context.Node.Desc in AllClasses)
|
|
then
|
|
Include(Flags,iliHasChilds);
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIdentifierListItem.CanBeAssigned: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
ANode:=Node;
|
|
if (ANode=nil) then exit;
|
|
if (GetDesc=ctnVarDefinition) then
|
|
Result:=true;
|
|
if (ANode.Desc in [ctnProperty,ctnGlobalProperty]) then begin
|
|
if Tool.PropertyHasSpecifier(ANode,'write') then exit(true);
|
|
if Tool.PropNodeIsTypeLess(ANode) then begin
|
|
exit(true);// ToDo: search the real property definition
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentifierListItem.UpdateBaseContext;
|
|
var
|
|
Params: TFindDeclarationParams;
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if (iliBaseExprTypeValid in Flags) then exit;
|
|
Include(Flags,iliBaseExprTypeValid);
|
|
BaseExprType:=CleanExpressionType;
|
|
BaseExprType.Desc:=xtNone;
|
|
ANode:=Node;
|
|
if (ANode<>nil) and (Tool<>nil) then begin
|
|
Tool.ActivateGlobalWriteLock;
|
|
Params:=TFindDeclarationParams.Create(Tool, ANode);
|
|
try
|
|
if ANode.HasParentOfType(ctnGenericType) then exit;
|
|
BaseExprType.Context:=Tool.FindBaseTypeOfNode(Params,ANode);
|
|
if (BaseExprType.Context.Node<>nil) then
|
|
BaseExprType.Desc:=xtContext;
|
|
finally
|
|
Params.Free;
|
|
Tool.DeactivateGlobalWriteLock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIdentifierListItem.HasChilds: boolean;
|
|
begin
|
|
Result:=iliHasChilds in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.HasIndex: boolean;
|
|
// check if edged bracket can be used []
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliHasIndexValid in Flags) then begin
|
|
UpdateBaseContext;
|
|
if BaseExprType.Desc in (xtAllStringConvertibles+xtAllWideStringConvertibles)
|
|
then begin
|
|
// strings, widestrings and PChar
|
|
Include(Flags,iliHasIndex);
|
|
end else if (BaseExprType.Desc=xtContext) and (BaseExprType.Context.Node<>nil)
|
|
then begin
|
|
//debugln(['TIdentifierListItem.HasIndex ',BaseExprType.Context.Node.DescAsString]);
|
|
ANode:=BaseExprType.Context.Node;
|
|
case ANode.Desc of
|
|
ctnRangedArrayType,ctnOpenArrayType: Include(Flags,iliHasIndex);
|
|
end;
|
|
end;
|
|
end;
|
|
Result:=iliHasIndex in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.IsFunction: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliIsFunctionValid in Flags) then
|
|
begin
|
|
ANode := Node;
|
|
if (ANode <> nil) and Tool.NodeIsFunction(ANode) then
|
|
Include(Flags, iliIsFunction);
|
|
Include(Flags, iliIsFunctionValid);
|
|
end;
|
|
Result := iliIsFunction in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.IsConstructor: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliIsConstructorValid in Flags) then
|
|
begin
|
|
ANode := Node;
|
|
if (ANode <> nil) and Tool.NodeIsConstructor(ANode) then
|
|
Include(Flags, iliIsConstructor);
|
|
Include(Flags, iliIsConstructorValid);
|
|
end;
|
|
Result := iliIsConstructor in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.IsDestructor: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliIsDestructorValid in Flags) then
|
|
begin
|
|
ANode := Node;
|
|
if (ANode <> nil) and Tool.NodeIsDestructor(ANode) then
|
|
Include(Flags, iliIsDestructor);
|
|
Include(Flags, iliIsDestructorValid);
|
|
end;
|
|
Result := iliIsDestructor in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.IsAbstractMethod: boolean;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
begin
|
|
if not (iliIsAbstractMethodValid in Flags) then begin
|
|
ANode:=Node;
|
|
if (ANode<>nil)
|
|
and Tool.ProcNodeHasSpecifier(ANode,psABSTRACT) then
|
|
Include(Flags,iliIsAbstractMethod);
|
|
Include(Flags,iliIsAbstractMethodValid);
|
|
end;
|
|
Result:=iliIsAbstractMethod in Flags;
|
|
end;
|
|
|
|
function TIdentifierListItem.TryIsAbstractMethod: boolean;
|
|
begin
|
|
try
|
|
Result:=IsAbstractMethod;
|
|
except
|
|
Result:=false;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdentifierListItem.Clear;
|
|
begin
|
|
FParamTypeList:='';
|
|
FResultType:='';
|
|
Compatibility:=icompUnknown;
|
|
HistoryIndex:=0;
|
|
Identifier:='';
|
|
Level:=0;
|
|
FNode:=nil;
|
|
Tool:=nil;
|
|
DefaultDesc:=ctnNone;
|
|
Flags:=[];
|
|
BaseExprType:=CleanExpressionType;
|
|
end;
|
|
|
|
procedure TIdentifierListItem.UnbindNode;
|
|
begin
|
|
if FNode=nil then exit;
|
|
StoreNodeHash;
|
|
Exclude(Flags,iliNodeValid);
|
|
FNode:=nil;
|
|
end;
|
|
|
|
procedure TIdentifierListItem.StoreNodeHash;
|
|
begin
|
|
Include(Flags,iliNodeHashValid);
|
|
FNodeStartPos:=FNode.StartPos;
|
|
FNodeDesc:=FNode.Desc;
|
|
FNodeHash:=GetNodeHash(FNode);
|
|
//DebugLn(['TIdentifierListItem.StoreNodeHash ',Identifier,' Pos=',FNodeStartPos,' Hash=',FNodeHash]);
|
|
end;
|
|
|
|
function TIdentifierListItem.RestoreNode: boolean;
|
|
var
|
|
NewNode: TCodeTreeNode;
|
|
NewHash: Cardinal;
|
|
begin
|
|
if not (iliNodeHashValid in Flags) then exit(true);
|
|
//DebugLn(['TIdentifierListItem.RestoreNode ',Identifier]);
|
|
NewNode:=Tool.BuildSubTreeAndFindDeepestNodeAtPos(FNodeStartPos,false);
|
|
Result:=false;
|
|
if (NewNode=nil) or (NewNode.StartPos<>FNodeStartPos)
|
|
or (NewNode.Desc<>FNodeDesc) then begin
|
|
DebugLn(['TIdentifierListItem.RestoreNode not found: ',Identifier]);
|
|
Exclude(Flags,iliNodeHashValid);
|
|
exit;
|
|
end;
|
|
NewHash:=GetNodeHash(NewNode);
|
|
if NewHash<>FNodeHash then begin
|
|
DebugLn(['TIdentifierListItem.RestoreNode hash changed: ',Identifier]);
|
|
Exclude(Flags,iliNodeHashValid);
|
|
exit;
|
|
end;
|
|
//DebugLn(['TIdentifierListItem.RestoreNode Success ',Identifier]);
|
|
Node:=NewNode;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TIdentifierListItem.GetNodeHash(ANode: TCodeTreeNode): Cardinal;
|
|
var
|
|
StartPos: LongInt;
|
|
EndPos: LongInt;
|
|
begin
|
|
case ANode.Desc of
|
|
ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnGenericType:
|
|
ANode:=Tool.FindDefinitionNameNode(ANode);
|
|
end;
|
|
if ANode<>nil then
|
|
begin
|
|
StartPos:=ANode.StartPos;
|
|
EndPos:=StartPos+20;
|
|
if EndPos>ANode.EndPos then EndPos:=ANode.EndPos;
|
|
Result:=crc32(0, @Tool.Src[StartPos], EndPos-StartPos);
|
|
end else
|
|
Result:=0;
|
|
end;
|
|
|
|
function TIdentifierListItem.CompareParamList(CompareItem: TIdentifierListItem
|
|
): integer;
|
|
var
|
|
ANode: TCodeTreeNode;
|
|
CmpNode: TCodeTreeNode;
|
|
begin
|
|
Result:=0;
|
|
if Self=CompareItem then exit;
|
|
ANode:=Node;
|
|
CmpNode:=CompareItem.Node;
|
|
if (ANode=CmpNode) then exit;
|
|
if (ANode=nil) or (CmpNode=nil) then exit;
|
|
if (ANode.Desc<>ctnProcedure) or (CmpNode.Desc<>ctnProcedure) then
|
|
exit;
|
|
{DbgOut('TIdentifierListItem.CompareParamList ',GetIdentifier(Identifier),'=',GetIdentifier(CompareItem.Identifier));
|
|
if Node<>nil then
|
|
DbgOut(' Self=',Tool.MainFilename,' ',dbgs(Node.StartPos));
|
|
if CompareItem.Node<>nil then
|
|
DbgOut(' Other=',CompareItem.Tool.MainFilename,' ',dbgs(CompareItem.Node.StartPos));
|
|
debugln('');}
|
|
Result:=CompareTextIgnoringSpace(ParamTypeList,CompareItem.ParamTypeList,false);
|
|
end;
|
|
|
|
function TIdentifierListItem.CompareParamList(
|
|
CompareItem: TIdentifierListSearchItem): integer;
|
|
begin
|
|
if (ParamTypeList='') and (CompareItem.ParamList='') then
|
|
exit(0);
|
|
Result:=CompareTextIgnoringSpace(ParamTypeList,CompareItem.ParamList,false);
|
|
end;
|
|
|
|
function TIdentifierListItem.CalcMemSize: PtrUInt;
|
|
begin
|
|
Result:=PtrUInt(InstanceSize)
|
|
+MemSizeString(FParamTypeList)
|
|
+SizeOf(FNodeHash)
|
|
+MemSizeString(Identifier);
|
|
end;
|
|
|
|
{ TIdentifierHistoryList }
|
|
|
|
procedure TIdentifierHistoryList.SetCapacity(const AValue: integer);
|
|
begin
|
|
if FCapacity=AValue then exit;
|
|
FCapacity:=AValue;
|
|
if FCapacity<1 then FCapacity:=1;
|
|
while (FItems.Count>0) and (FItems.Count>=FCapacity) do
|
|
FItems.FreeAndDelete(FItems.FindHighest);
|
|
end;
|
|
|
|
function TIdentifierHistoryList.FindItem(NewItem: TIdentifierListItem
|
|
): TAVLTreeNode;
|
|
begin
|
|
if NewItem<>nil then
|
|
Result:=FItems.FindKey(NewItem,@CompareIdentItemWithHistListItem)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
constructor TIdentifierHistoryList.Create;
|
|
begin
|
|
FItems:=TAVLTree.Create(@CompareIdentHistListItem);
|
|
FCapacity:=30;
|
|
end;
|
|
|
|
destructor TIdentifierHistoryList.Destroy;
|
|
begin
|
|
Clear;
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TIdentifierHistoryList.Clear;
|
|
begin
|
|
FItems.FreeAndClear;
|
|
end;
|
|
|
|
procedure TIdentifierHistoryList.Add(NewItem: TIdentifierListItem);
|
|
var
|
|
OldAVLNode: TAVLTreeNode;
|
|
NewHistItem: TIdentHistListItem;
|
|
AnAVLNode: TAVLTreeNode;
|
|
AdjustIndex: Integer;
|
|
AnHistItem: TIdentHistListItem;
|
|
begin
|
|
if NewItem=nil then exit;
|
|
OldAVLNode:=FindItem(NewItem);
|
|
{$IFDEF ShowHistory}
|
|
DebugLn('TIdentifierHistoryList.Add Count=',Count,' Found=',OldAVLNode<>nil,
|
|
' ITEM: ',NewItem.AsString);
|
|
{$ENDIF}
|
|
if OldAVLNode<>nil then begin
|
|
// already in tree
|
|
NewHistItem:=TIdentHistListItem(OldAVLNode.Data);
|
|
if NewHistItem.HistoryIndex=0 then exit;
|
|
// must be moved -> remove it from the tree
|
|
AdjustIndex:=NewHistItem.HistoryIndex;
|
|
FItems.Delete(OldAVLNode);
|
|
end else begin
|
|
// create a new history item
|
|
NewHistItem:=TIdentHistListItem.Create;
|
|
NewHistItem.Identifier:=NewItem.Identifier;
|
|
NewHistItem.NodeDesc:=NewItem.GetDesc;
|
|
NewHistItem.ParamList:=NewItem.ParamTypeList;
|
|
AdjustIndex:=0;
|
|
end;
|
|
NewHistItem.HistoryIndex:=0;
|
|
// adjust all other HistoryIndex
|
|
AnAVLNode:=Fitems.FindLowest;
|
|
while AnAVLNode<>nil do begin
|
|
AnHistItem:=TIdentHistListItem(AnAVLNode.Data);
|
|
if AnHistItem.HistoryIndex>=AdjustIndex then
|
|
inc(AnHistItem.HistoryIndex);
|
|
AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
|
|
end;
|
|
if (FItems.Count>0) and (FItems.Count>=FCapacity) then
|
|
FItems.FreeAndDelete(FItems.FindHighest);
|
|
FItems.Add(NewHistItem);
|
|
{$IFDEF ShowHistory}
|
|
DebugLn('TIdentifierHistoryList.Added Count=',Count);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TIdentifierHistoryList.GetHistoryIndex(AnItem: TIdentifierListItem
|
|
): integer;
|
|
var
|
|
AnAVLNode: TAVLTreeNode;
|
|
begin
|
|
AnAVLNode:=FindItem(AnItem);
|
|
if AnAVLNode=nil then
|
|
Result:=33333333 // a very high value
|
|
else
|
|
Result:=TIdentHistListItem(AnAVLNode.Data).HistoryIndex;
|
|
end;
|
|
|
|
function TIdentifierHistoryList.Count: integer;
|
|
begin
|
|
Result:=FItems.Count;
|
|
end;
|
|
|
|
function TIdentifierHistoryList.CalcMemSize: PtrUInt;
|
|
var
|
|
Node: TAVLTreeNode;
|
|
Item: TIdentHistListItem;
|
|
begin
|
|
Result:=PtrUInt(InstanceSize);
|
|
if FItems<>nil then begin
|
|
{%H-}inc(Result,FItems.Count*SizeOf(TAVLTreeNode));
|
|
Node:=FItems.FindLowest;
|
|
while Node<>nil do begin
|
|
Item:=TIdentHistListItem(Node.Data);
|
|
inc(Result,Item.CalcMemSize);
|
|
Node:=FItems.FindSuccessor(Node);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TCodeContextInfo }
|
|
|
|
function TCodeContextInfo.GetItems(Index: integer): TCodeContextInfoItem;
|
|
begin
|
|
Result:=TCodeContextInfoItem(FItems[Index]);
|
|
end;
|
|
|
|
constructor TCodeContextInfo.Create;
|
|
begin
|
|
FItems:=TFPList.Create;
|
|
end;
|
|
|
|
destructor TCodeContextInfo.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(FItems);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCodeContextInfo.Count: integer;
|
|
begin
|
|
Result:=FItems.Count;
|
|
end;
|
|
|
|
function TCodeContextInfo.Add(const Context: TExpressionType): integer;
|
|
var
|
|
Item: TCodeContextInfoItem;
|
|
begin
|
|
Item:=TCodeContextInfoItem.Create;
|
|
Item.Expr:=Context;
|
|
Result:=FItems.Add(Item);
|
|
end;
|
|
|
|
function TCodeContextInfo.AddCompilerProc: integer;
|
|
var
|
|
Item: TCodeContextInfoItem;
|
|
begin
|
|
Item:=TCodeContextInfoItem.Create;
|
|
Result:=FItems.Add(Item);
|
|
end;
|
|
|
|
procedure TCodeContextInfo.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to FItems.Count-1 do
|
|
TObject(FItems[i]).Free;
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TCodeContextInfo.CalcMemSize: PtrUInt;
|
|
begin
|
|
Result:=PtrUInt(InstanceSize)
|
|
+{%H-}PtrUInt(TCodeContextInfoItem)*SizeOf(FItems.Count)
|
|
+MemSizeString(FProcName);
|
|
end;
|
|
|
|
{ TIdentifierListSearchItem }
|
|
|
|
function TIdentifierListSearchItem.CalcMemSize: PtrUInt;
|
|
begin
|
|
Result:=PtrUInt(InstanceSize)
|
|
+MemSizeString(ParamList);
|
|
end;
|
|
|
|
{ TIdentHistListItem }
|
|
|
|
function TIdentHistListItem.CalcMemSize: PtrUInt;
|
|
begin
|
|
Result:=PtrUInt(InstanceSize)
|
|
+MemSizeString(Identifier)
|
|
+MemSizeString(ParamList);
|
|
end;
|
|
|
|
{ TCodeContextInfoItem }
|
|
|
|
destructor TCodeContextInfoItem.Destroy;
|
|
begin
|
|
FreeAndNil(Params);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|
|
|