mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-10 05:56:02 +02:00
IDE, CodeTools: support for unit names with dots. Issue #22235
git-svn-id: trunk@50266 -
This commit is contained in:
ondrej
parent
7395b9b047
commit
d49143fd83
@ -41,7 +41,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, AVL_Tree, SourceLog, KeywordFuncLists, FileProcs,
|
||||
LazFileUtils, LazUTF8;
|
||||
LazFileUtils, LazUTF8, strutils;
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
{ These functions are used by the codetools }
|
||||
@ -225,22 +225,49 @@ type
|
||||
private
|
||||
FFilename: string;
|
||||
FUnitName: string;
|
||||
function GetFileUnitNameWithoutNamespace: string;
|
||||
function GetIdentifierStartInUnitName: Integer;
|
||||
public
|
||||
constructor Create(const TheUnitName, TheFilename: string);
|
||||
property FileUnitName: string read FUnitName;
|
||||
property FileUnitNameWithoutNamespace: string read GetFileUnitNameWithoutNamespace;
|
||||
property Filename: string read FFilename;
|
||||
property IdentifierStartInUnitName: Integer read GetIdentifierStartInUnitName;
|
||||
end;
|
||||
|
||||
TNameSpaceInfo = class
|
||||
private
|
||||
FFilename: string;
|
||||
FNamespace: string;
|
||||
FIdentifierStartInUnitName: Integer;
|
||||
public
|
||||
constructor Create(const TheNamespace, TheFilename: string; TheIdentifierStartInUnitName: Integer);
|
||||
property Filename: string read FFilename;
|
||||
property Namespace: string read FNamespace;
|
||||
property IdentifierStartInUnitName: Integer read FIdentifierStartInUnitName;
|
||||
end;
|
||||
|
||||
|
||||
procedure AddToTreeOfUnitFilesOrNamespaces(
|
||||
var TreeOfUnitFiles, TreeOfNameSpaces: TAVLTree;
|
||||
const NameSpacePath, Filename: string;
|
||||
CaseInsensitive, KeepDoubles: boolean);
|
||||
function GatherUnitFiles(const BaseDir, SearchPath,
|
||||
Extensions: string; KeepDoubles, CaseInsensitive: boolean;
|
||||
var TreeOfUnitFiles: TAVLTree): boolean;
|
||||
Extensions, NameSpacePath: string; KeepDoubles, CaseInsensitive: boolean;
|
||||
var TreeOfUnitFiles, TreeOfNamespaces: TAVLTree): boolean;
|
||||
procedure FreeTreeOfUnitFiles(TreeOfUnitFiles: TAVLTree);
|
||||
procedure AddToTreeOfUnitFiles(var TreeOfUnitFiles: TAVLTree;
|
||||
const Filename: string;
|
||||
const Filename, Unitname: string;
|
||||
KeepDoubles: boolean);
|
||||
procedure AddToTreeOfNamespaces(var TreeOfNameSpaces: TAVLTree;
|
||||
const FileName, UnitName, ParentNameSpacePath: string;
|
||||
KeepDoubles: boolean);
|
||||
function CompareUnitFileInfos(Data1, Data2: Pointer): integer;
|
||||
function CompareNameSpaceInfos(Data1, Data2: Pointer): integer;
|
||||
function CompareUnitNameAndUnitFileInfo(UnitnamePAnsiString,
|
||||
UnitFileInfo: Pointer): integer;
|
||||
function CompareNameSpaceAndNameSpaceInfo(NamespacePAnsiString,
|
||||
NamespaceInfo: Pointer): integer;
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
// functions / procedures
|
||||
@ -5636,15 +5663,61 @@ begin
|
||||
System.Move(p^,Result[1],l);
|
||||
end;
|
||||
|
||||
function GatherUnitFiles(const BaseDir, SearchPath,
|
||||
Extensions: string; KeepDoubles, CaseInsensitive: boolean;
|
||||
var TreeOfUnitFiles: TAVLTree): boolean;
|
||||
procedure AddToTreeOfUnitFilesOrNamespaces(var TreeOfUnitFiles,
|
||||
TreeOfNameSpaces: TAVLTree; const NameSpacePath, Filename: string;
|
||||
CaseInsensitive, KeepDoubles: boolean);
|
||||
|
||||
procedure FileAndNameSpaceFits(const UnitName: string; out FileNameFits, NameSpaceFits: Boolean);
|
||||
var
|
||||
CompareCaseInsensitive: Boolean;
|
||||
begin
|
||||
FileNameFits := False;
|
||||
NameSpaceFits := False;
|
||||
if NameSpacePath = '' then begin
|
||||
//we search for files without namespace path
|
||||
FileNameFits := pos('.', UnitName) = 0;
|
||||
NameSpaceFits := not FileNameFits;
|
||||
Exit;
|
||||
end;
|
||||
if Length(UnitName) < Length(NameSpacePath) then Exit;
|
||||
|
||||
CompareCaseInsensitive:=CaseInsensitive;
|
||||
{$IFDEF Windows}
|
||||
CompareCaseInsensitive:=true;
|
||||
{$ENDIF}
|
||||
|
||||
if CompareText(PChar(UnitName), Length(NameSpacePath), PChar(NameSpacePath), Length(NameSpacePath), not CompareCaseInsensitive) = 0 then
|
||||
begin
|
||||
FileNameFits := PosEx('.', UnitName, Length(NameSpacePath)+1) = 0;
|
||||
NameSpaceFits := not FileNameFits;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
FileNameFits, NameSpaceFits: Boolean;
|
||||
UnitName: string;
|
||||
begin
|
||||
UnitName := ExtractFileNameOnly(Filename);
|
||||
FileAndNameSpaceFits(UnitName, FileNameFits, NameSpaceFits);
|
||||
if FileNameFits then
|
||||
AddToTreeOfUnitFiles(TreeOfUnitFiles,FileName,UnitName,
|
||||
KeepDoubles);
|
||||
if NameSpaceFits then
|
||||
AddToTreeOfNamespaces(TreeOfNamespaces,FileName,UnitName,NameSpacePath,
|
||||
KeepDoubles)
|
||||
end;
|
||||
|
||||
function GatherUnitFiles(const BaseDir, SearchPath, Extensions,
|
||||
NameSpacePath: string; KeepDoubles, CaseInsensitive: boolean;
|
||||
var TreeOfUnitFiles, TreeOfNamespaces: TAVLTree): boolean;
|
||||
// BaseDir: base directory, used when SearchPath is relative
|
||||
// SearchPath: semicolon separated list of directories
|
||||
// Extensions: semicolon separated list of extensions (e.g. 'pas;.pp;ppu')
|
||||
// NameSpacePath: gather files only from this namespace path
|
||||
// KeepDoubles: false to return only the first match of each unit
|
||||
// CaseInsensitive: true to ignore case on comparing extensions
|
||||
// TreeOfUnitFiles: tree of TUnitFileInfo
|
||||
// TreeOfNamespaces: tree of TNameSpaceInfo
|
||||
var
|
||||
SearchedDirectories: TAVLTree; // tree of AnsiString
|
||||
|
||||
@ -5760,8 +5833,8 @@ var
|
||||
then
|
||||
continue;
|
||||
if ExtensionFits(FileInfo.Name) then begin
|
||||
AddToTreeOfUnitFiles(TreeOfUnitFiles,ADirectory+FileInfo.Name,
|
||||
KeepDoubles);
|
||||
AddToTreeOfUnitFilesOrNamespaces(TreeOfUnitFiles, TreeOfNamespaces,
|
||||
NameSpacePath, ADirectory+FileInfo.Name, CaseInsensitive, KeepDoubles);
|
||||
end;
|
||||
until FindNextUTF8(FileInfo)<>0;
|
||||
end;
|
||||
@ -5808,16 +5881,14 @@ begin
|
||||
TreeOfUnitFiles.Free;
|
||||
end;
|
||||
|
||||
procedure AddToTreeOfUnitFiles(var TreeOfUnitFiles: TAVLTree;
|
||||
const Filename: string; KeepDoubles: boolean);
|
||||
procedure AddToTreeOfUnitFiles(var TreeOfUnitFiles: TAVLTree; const Filename,
|
||||
Unitname: string; KeepDoubles: boolean);
|
||||
var
|
||||
AnUnitName: String;
|
||||
NewItem: TUnitFileInfo;
|
||||
begin
|
||||
AnUnitName:=ExtractFileNameOnly(Filename);
|
||||
if (not KeepDoubles) then begin
|
||||
if (TreeOfUnitFiles<>nil)
|
||||
and (TreeOfUnitFiles.FindKey(Pointer(AnUnitName),
|
||||
and (TreeOfUnitFiles.FindKey(Pointer(UnitName),
|
||||
@CompareUnitNameAndUnitFileInfo)<>nil)
|
||||
then begin
|
||||
// an unit with the same name was already found and doubles are not
|
||||
@ -5828,21 +5899,64 @@ begin
|
||||
// add
|
||||
if TreeOfUnitFiles=nil then
|
||||
TreeOfUnitFiles:=TAVLTree.Create(@CompareUnitFileInfos);
|
||||
NewItem:=TUnitFileInfo.Create(AnUnitName,Filename);
|
||||
NewItem:=TUnitFileInfo.Create(UnitName,Filename);
|
||||
TreeOfUnitFiles.Add(NewItem);
|
||||
end;
|
||||
|
||||
procedure AddToTreeOfNamespaces(var TreeOfNameSpaces: TAVLTree; const FileName,
|
||||
UnitName, ParentNameSpacePath: string; KeepDoubles: boolean);
|
||||
var
|
||||
AnNameSpace: String;
|
||||
NewItem: TNameSpaceInfo;
|
||||
PointPos: Integer;
|
||||
begin
|
||||
PointPos := PosEx('.', UnitName, Length(ParentNameSpacePath)+1);
|
||||
if PointPos = 0 then Exit;
|
||||
AnNameSpace:=Copy(UnitName, Length(ParentNameSpacePath)+1, PointPos - Length(ParentNameSpacePath) - 1);
|
||||
if AnNameSpace = '' then Exit;
|
||||
if (not KeepDoubles) then begin
|
||||
if (TreeOfNameSpaces<>nil)
|
||||
and (TreeOfNameSpaces.FindKey(Pointer(AnNameSpace),
|
||||
@CompareNameSpaceAndNameSpaceInfo)<>nil)
|
||||
then begin
|
||||
// a namespace with the same name was already found and doubles are not
|
||||
// wanted
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
// add
|
||||
if TreeOfNameSpaces=nil then
|
||||
TreeOfNameSpaces:=TAVLTree.Create(@CompareNameSpaceInfos);
|
||||
NewItem:=TNameSpaceInfo.Create(AnNameSpace,FileName,Length(ParentNameSpacePath)+1);
|
||||
TreeOfNameSpaces.Add(NewItem);
|
||||
end;
|
||||
|
||||
function CompareUnitFileInfos(Data1, Data2: Pointer): integer;
|
||||
begin
|
||||
Result:=CompareIdentifiers(PChar(TUnitFileInfo(Data1).FileUnitName),
|
||||
PChar(TUnitFileInfo(Data2).FileUnitName));
|
||||
end;
|
||||
|
||||
function CompareNameSpaceInfos(Data1, Data2: Pointer): integer;
|
||||
begin
|
||||
Result:=CompareIdentifiers(PChar(TNameSpaceInfo(Data1).NameSpace),
|
||||
PChar(TNameSpaceInfo(Data2).NameSpace));
|
||||
end;
|
||||
|
||||
function CompareUnitNameAndUnitFileInfo(UnitnamePAnsiString,
|
||||
UnitFileInfo: Pointer): integer;
|
||||
begin
|
||||
Result:=CompareIdentifiers(PChar(UnitnamePAnsiString),
|
||||
PChar(TUnitFileInfo(UnitFileInfo).FileUnitName));
|
||||
//do not use CompareIdentifiers - they compare only to the first "."
|
||||
Result:=CompareText(PChar(UnitnamePAnsiString),
|
||||
PChar(TUnitFileInfo(UnitFileInfo).FileUnitName));
|
||||
end;
|
||||
|
||||
function CompareNameSpaceAndNameSpaceInfo(NamespacePAnsiString,
|
||||
NamespaceInfo: Pointer): integer;
|
||||
begin
|
||||
//do not use CompareIdentifiers - they compare only to the first "."
|
||||
Result:=CompareText(PChar(NamespacePAnsiString),
|
||||
PChar(TNameSpaceInfo(NamespaceInfo).NameSpace));
|
||||
end;
|
||||
|
||||
function CountNeededLineEndsToAddForward(const Src: string;
|
||||
@ -5973,6 +6087,16 @@ begin
|
||||
Result:=CompareText(Txt1,Len1,Txt2,Len2,CaseSensitive);
|
||||
end;
|
||||
|
||||
{ TNameSpaceInfo }
|
||||
|
||||
constructor TNameSpaceInfo.Create(const TheNamespace, TheFilename: string;
|
||||
TheIdentifierStartInUnitName: Integer);
|
||||
begin
|
||||
FNamespace:=TheNamespace;
|
||||
FFilename:=TheFilename;
|
||||
FIdentifierStartInUnitName:=TheIdentifierStartInUnitName;
|
||||
end;
|
||||
|
||||
{ TUnitFileInfo }
|
||||
|
||||
constructor TUnitFileInfo.Create(const TheUnitName, TheFilename: string);
|
||||
@ -5981,6 +6105,27 @@ begin
|
||||
FFilename:=TheFilename;
|
||||
end;
|
||||
|
||||
function TUnitFileInfo.GetFileUnitNameWithoutNamespace: string;
|
||||
var
|
||||
LastPoint: Integer;
|
||||
begin
|
||||
LastPoint := LastDelimiter('.', FUnitName);
|
||||
if LastPoint > 0 then
|
||||
Result := Copy(FUnitName, LastPoint+1, High(Integer))
|
||||
else
|
||||
Result := FUnitName;
|
||||
end;
|
||||
|
||||
function TUnitFileInfo.GetIdentifierStartInUnitName: Integer;
|
||||
var
|
||||
LastPoint: Integer;
|
||||
begin
|
||||
LastPoint := LastDelimiter('.', FUnitName);
|
||||
if LastPoint > 0 then
|
||||
Result := LastPoint+1
|
||||
else
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
//=============================================================================
|
||||
|
||||
|
||||
@ -80,8 +80,10 @@ const
|
||||
ctnVarDefinition = 21;
|
||||
ctnConstDefinition = 22;
|
||||
ctnGlobalProperty = 23;
|
||||
ctnUseUnit = 24; // StartPos=unitname, EndPos=unitname+inFilename
|
||||
ctnUseUnit = 24; // StartPos=unit, EndPos=unitname+inFilename, children ctnUseUnitNamespace, ctnUseUnitClearName
|
||||
ctnVarArgs = 25;
|
||||
ctnUseUnitNamespace = 26; // <namespace>.clearname.pas
|
||||
ctnUseUnitClearName = 27; // namespace.<clearname>.pas
|
||||
|
||||
ctnClass = 30;
|
||||
ctnClassInterface = 31;
|
||||
@ -194,7 +196,7 @@ const
|
||||
ctnInitialization,ctnFinalization];
|
||||
AllFindContextDescs = AllIdentifierDefinitions + AllCodeSections + AllClasses +
|
||||
[ctnProcedure];
|
||||
AllPointContexts = AllClasses+AllSourceTypes+[ctnEnumerationType,ctnInterface,ctnImplementation,ctnTypeType];
|
||||
AllPointContexts = AllClasses+AllSourceTypes+[ctnEnumerationType,ctnInterface,ctnImplementation,ctnTypeType,ctnUseUnitNamespace,ctnUseUnitClearName];
|
||||
|
||||
|
||||
// CodeTreeNodeSubDescriptors
|
||||
@ -397,6 +399,8 @@ begin
|
||||
ctnPackage: Result:='Package';
|
||||
ctnLibrary: Result:='Library';
|
||||
ctnUnit: Result:='Unit';
|
||||
ctnUseUnitNamespace: Result:='Namespace';
|
||||
ctnUseUnitClearName: Result:='Unit name without namespace';
|
||||
ctnInterface: Result:='Interface Section';
|
||||
ctnImplementation: Result:='Implementation';
|
||||
ctnInitialization: Result:='Initialization';
|
||||
|
||||
@ -2191,7 +2191,16 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsString(CursorNode.Desc),' HasChildren=',dbgs(CursorNode.FirstChild<>nil));
|
||||
{$ENDIF}
|
||||
if (CursorNode.Desc in [ctnUsesSection,ctnUseUnit]) then begin
|
||||
if (CursorNode.Desc = ctnUseUnitNamespace) then begin
|
||||
NewExprType.Desc:=xtContext;
|
||||
NewExprType.Context.Node:=CursorNode;
|
||||
NewExprType.Context.Tool:=Self;
|
||||
CleanPosToCaret(CursorNode.StartPos, NewPos);
|
||||
NewTopLine := NewPos.Y;
|
||||
Result := True;
|
||||
Exit;
|
||||
end else
|
||||
if (CursorNode.Desc in [ctnUsesSection,ctnUseUnitClearName]) then begin
|
||||
// in uses section
|
||||
//DebugLn(['TFindDeclarationTool.FindDeclaration IsUsesSection']);
|
||||
Result:=FindDeclarationInUsesSection(CursorNode,CleanCursorPos,
|
||||
@ -2751,7 +2760,10 @@ begin
|
||||
ReadNextAtom;
|
||||
if not UpAtomIs('USES') then
|
||||
RaiseUsesExpected;
|
||||
end;
|
||||
end else
|
||||
if (UsesNode.Desc = ctnUseUnitClearName) then
|
||||
MoveCursorToNodeStart(UsesNode.Parent);
|
||||
|
||||
repeat
|
||||
ReadNextAtom; // read name
|
||||
if CurPos.StartPos>CleanPos then break;
|
||||
@ -3261,11 +3273,20 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
ctnUseUnit:
|
||||
ctnUseUnitNamespace:
|
||||
begin
|
||||
// hint for unit namespace in "uses" section
|
||||
Result += 'namespace ';
|
||||
MoveCursorToNodeStart(Node);
|
||||
ReadNextAtom;
|
||||
Result := Result + GetAtom;
|
||||
end;
|
||||
|
||||
ctnUseUnitClearName:
|
||||
begin
|
||||
// hint for unit in "uses" section
|
||||
Result += 'unit ';
|
||||
MoveCursorToNodeStart(Node);
|
||||
MoveCursorToNodeStart(Node.Parent);
|
||||
Result := Result + ReadIdentifierWithDots;
|
||||
end
|
||||
|
||||
@ -3974,6 +3995,55 @@ var
|
||||
//debugln(['SearchInHelpers END']);
|
||||
end;
|
||||
|
||||
function SearchInNamespaces(UsesNode, SourceNamespaceNode: TCodeTreeNode): Boolean;
|
||||
var
|
||||
UnitNode, ThisNamespaceNode, TargetNamespaceNode: TCodeTreeNode;
|
||||
Match: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if UsesNode=nil then Exit;
|
||||
|
||||
UnitNode := UsesNode.LastChild;
|
||||
while UnitNode<>nil do
|
||||
begin
|
||||
ThisNamespaceNode := SourceNamespaceNode.Parent.FirstChild;
|
||||
TargetNamespaceNode := UnitNode.FirstChild;
|
||||
Match := False;
|
||||
while (ThisNamespaceNode<>nil) and (TargetNamespaceNode<>nil) do
|
||||
begin
|
||||
if CompareIdentifiers(
|
||||
@Src[ThisNamespaceNode.StartPos],
|
||||
@Src[TargetNamespaceNode.StartPos]) <> 0
|
||||
then Break;
|
||||
|
||||
if (ThisNamespaceNode=SourceNamespaceNode) then
|
||||
begin
|
||||
Match := True;
|
||||
Break;
|
||||
end;
|
||||
|
||||
ThisNamespaceNode := ThisNamespaceNode.NextBrother;
|
||||
TargetNamespaceNode := TargetNamespaceNode.NextBrother;
|
||||
end;
|
||||
if Match then
|
||||
begin
|
||||
//namespace paths match
|
||||
if (TargetNamespaceNode.NextBrother<>nil)
|
||||
and (
|
||||
(Params.Identifier=nil) or
|
||||
CompareSrcIdentifiers(TargetNamespaceNode.NextBrother.StartPos,Params.Identifier))
|
||||
then begin
|
||||
Params.SetResult(Self,TargetNamespaceNode.NextBrother);
|
||||
Result:=CheckResult(true,true);
|
||||
if not (fdfCollect in Flags) then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
UnitNode := UnitNode.PriorBrother;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SearchNextNode: boolean;
|
||||
const
|
||||
AbortNoCacheResult = false;
|
||||
@ -4212,6 +4282,14 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (ContextNode.Desc=ctnUseUnitNamespace) then
|
||||
begin
|
||||
//search in namespaces
|
||||
if SearchInNamespaces(FindMainUsesNode, Params.ContextNode) then exit;
|
||||
if SearchInNamespaces(FindImplementationUsesNode, Params.ContextNode) then exit;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// find class helper functions
|
||||
SearchInHelpersInTheEnd := False;
|
||||
if (fdfSearchInHelpers in Flags)
|
||||
@ -6127,6 +6205,8 @@ begin
|
||||
ListOfPCodeXYPosition:=nil;
|
||||
BuildTreeAndGetCleanPos(CursorPos,CleanPos);
|
||||
Node:=FindDeepestNodeAtPos(CleanPos,true);
|
||||
if Node.Desc in [ctnUseUnitNamespace,ctnUseUnitClearName] then
|
||||
Node:=Node.Parent;
|
||||
if Node.Desc<>ctnUseUnit then
|
||||
RaiseException('This function needs the cursor at a unit in a uses clause');
|
||||
// cursor is on an used unit -> try to locate it
|
||||
@ -7333,19 +7413,20 @@ begin
|
||||
Node:=UsesNode.LastChild;
|
||||
while Node<>nil do begin
|
||||
if (fdfCollect in Params.Flags) then begin
|
||||
CollectResult:=DoOnIdentifierFound(Params,Node);
|
||||
CollectResult:=DoOnIdentifierFound(Params,Node.FirstChild);
|
||||
if CollectResult=ifrAbortSearch then begin
|
||||
Result:=false;
|
||||
exit;
|
||||
end else if CollectResult=ifrSuccess then begin
|
||||
Result:=true;
|
||||
Params.SetResult(Self,Node);
|
||||
Params.SetResult(Self,Node.FirstChild);
|
||||
exit;
|
||||
end;
|
||||
end else if CompareSrcIdentifiers(Node.StartPos,Params.Identifier) then begin
|
||||
// the searched identifier was a uses AUnitName, point to the identifier in
|
||||
// the uses section
|
||||
Params.SetResult(Self,Node,Node.StartPos);
|
||||
// if the unit name has a namespace defined point to the namespace
|
||||
Params.SetResult(Self,Node.FirstChild);
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
@ -8525,7 +8606,7 @@ var
|
||||
{$IFDEF ShowExprEval}
|
||||
debugln([' FindExpressionTypeOfTerm ResolveUseUnit used unit -> interface node ',dbgstr(ExprType.Context.Tool.ExtractNode(ExprType.Context.Node,[]))]);
|
||||
{$ENDIF}
|
||||
AnUnitName:=aTool.ExtractUsedUnitName(ExprType.Context.Node,@InFilename);
|
||||
AnUnitName:=aTool.ExtractUsedUnitName(ExprType.Context.Node.Parent,@InFilename);
|
||||
NewCodeTool:=aTool.FindCodeToolForUsedUnit(AnUnitName,InFilename,true);
|
||||
NewCodeTool.BuildInterfaceIdentifierCache(true);
|
||||
NewNode:=NewCodeTool.FindInterfaceNode;
|
||||
@ -8568,7 +8649,7 @@ var
|
||||
ExprType.Context.Node:=ExprType.Context.Tool.GetInterfaceNode;
|
||||
end;
|
||||
end
|
||||
else if (ExprType.Context.Node.Desc=ctnUseUnit) then begin
|
||||
else if (ExprType.Context.Node.Desc=ctnUseUnitClearName) then begin
|
||||
// uses unit name => interface of used unit
|
||||
ResolveUseUnit;
|
||||
end
|
||||
|
||||
@ -169,13 +169,20 @@ type
|
||||
function GetNodeHash(ANode: TCodeTreeNode): string;
|
||||
function CompareParamList(CompareItem: TIdentifierListItem): integer;
|
||||
function CompareParamList(CompareItem: TIdentifierListSearchItem): integer;
|
||||
function CalcMemSize: PtrUInt;
|
||||
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;
|
||||
|
||||
TUnitNameSpaceIdentifierListItem = class(TIdentifierListItem)
|
||||
public
|
||||
UnitFileName: string;
|
||||
IdentifierStartInUnitName: Integer;
|
||||
function CalcMemSize: PtrUInt; override;
|
||||
end;
|
||||
|
||||
TIdentifierListFlag = (
|
||||
ilfFilteredListNeedsUpdate,
|
||||
@ -360,6 +367,9 @@ type
|
||||
// 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);
|
||||
@ -376,7 +386,7 @@ type
|
||||
const Context, GatherContext: TFindContext);
|
||||
procedure GatherUsefulIdentifiers(CleanPos: integer;
|
||||
const Context, GatherContext: TFindContext);
|
||||
procedure GatherUnitnames;
|
||||
procedure GatherUnitnames(const NameSpacePath: string = '');
|
||||
procedure GatherSourceNames(const Context: TFindContext);
|
||||
procedure GatherContextKeywords(const Context: TFindContext;
|
||||
CleanPos: integer; BeautifyCodeOptions: TBeautifyCodeOptions);
|
||||
@ -503,6 +513,14 @@ begin
|
||||
Result:='['+Result+']';
|
||||
end;
|
||||
|
||||
{ TUnitNameSpaceIdentifierListItem }
|
||||
|
||||
function TUnitNameSpaceIdentifierListItem.CalcMemSize: PtrUInt;
|
||||
begin
|
||||
Result := inherited CalcMemSize
|
||||
+MemSizeString(UnitFileName);
|
||||
end;
|
||||
|
||||
{ TIdentifierList }
|
||||
|
||||
function TIdentifierList.CompareIdentListItems(Tree: TAvgLvlTree; Data1,
|
||||
@ -905,7 +923,8 @@ end;
|
||||
|
||||
procedure TIdentCompletionTool.AddToTreeOfUnitFileInfo(const AFilename: string);
|
||||
begin
|
||||
AddToTreeOfUnitFiles(FIDTTreeOfUnitFiles,AFilename,false);
|
||||
AddToTreeOfUnitFilesOrNamespaces(FIDTTreeOfUnitFiles,FIDTTreeOfNamespaces,
|
||||
FIDTTreeOfUnitFiles_NamespacePath,AFilename,FIDTTreeOfUnitFiles_CaseInsensitive,false);
|
||||
end;
|
||||
|
||||
procedure TIdentCompletionTool.AddCompilerProcedure(const AProcName, AParameterList: PChar);
|
||||
@ -1225,7 +1244,7 @@ begin
|
||||
ctnRecordCase:
|
||||
Ident:=@FoundContext.Tool.Src[Params.NewCleanPos];
|
||||
|
||||
ctnUseUnit:
|
||||
ctnUseUnitNamespace,ctnUseUnitClearName:
|
||||
if (FoundContext.Tool=Self) then begin
|
||||
Ident:=@Src[FoundContext.Node.StartPos];
|
||||
end;
|
||||
@ -1295,7 +1314,7 @@ procedure TIdentCompletionTool.GatherPredefinedIdentifiers(CleanPos: integer;
|
||||
CompilerFuncLevel,
|
||||
nil,
|
||||
nil,
|
||||
ctnUseUnit);
|
||||
ctnUseUnitClearName);
|
||||
CurrentIdentifierList.Add(NewItem);
|
||||
end;
|
||||
|
||||
@ -1486,7 +1505,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIdentCompletionTool.GatherUnitnames;
|
||||
procedure TIdentCompletionTool.GatherUnitnames(const NameSpacePath: string);
|
||||
|
||||
procedure GatherUnitsFromSet;
|
||||
begin
|
||||
@ -1499,10 +1518,11 @@ var
|
||||
BaseDir: String;
|
||||
ANode: TAVLTreeNode;
|
||||
UnitFileInfo: TUnitFileInfo;
|
||||
NewItem: TIdentifierListItem;
|
||||
NewItem: TUnitNameSpaceIdentifierListItem;
|
||||
UnitExt: String;
|
||||
SrcExt: String;
|
||||
CurSourceName: String;
|
||||
NameSpaceInfo: TNameSpaceInfo;
|
||||
begin
|
||||
UnitPath:='';
|
||||
SrcPath:='';
|
||||
@ -1510,37 +1530,64 @@ begin
|
||||
//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,false,true,FIDTTreeOfUnitFiles);
|
||||
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,false,true,FIDTTreeOfUnitFiles);
|
||||
GatherUnitFiles(BaseDir,SrcPath,SrcExt,NameSpacePath,false,true,FIDTTreeOfUnitFiles, FIDTTreeOfNamespaces);
|
||||
// add unitlinks
|
||||
GatherUnitsFromSet;
|
||||
// create list
|
||||
CurSourceName:=GetSourceName;
|
||||
ANode:=FIDTTreeOfUnitFiles.FindLowest;
|
||||
while ANode<>nil do begin
|
||||
UnitFileInfo:=TUnitFileInfo(ANode.Data);
|
||||
if CompareIdentifiers(PChar(Pointer(UnitFileInfo.FileUnitName)),
|
||||
PChar(Pointer(CurSourceName)))<>0
|
||||
then begin
|
||||
NewItem:=TIdentifierListItem.Create(
|
||||
icompCompatible,true,0,
|
||||
CurrentIdentifierList.CreateIdentifier(UnitFileInfo.FileUnitName),
|
||||
0,nil,nil,ctnUnit);
|
||||
CurrentIdentifierList.Add(NewItem);
|
||||
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
|
||||
// oooooo
|
||||
NewItem:=TUnitNameSpaceIdentifierListItem.Create(
|
||||
icompCompatible,true,0,
|
||||
CurrentIdentifierList.CreateIdentifier(UnitFileInfo.FileUnitNameWithoutNamespace),
|
||||
0,nil,nil,ctnUnit);
|
||||
NewItem.UnitFileName := UnitFileInfo.Filename;
|
||||
NewItem.IdentifierStartInUnitName := 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:=TUnitNameSpaceIdentifierListItem.Create(
|
||||
icompCompatible,true,0,
|
||||
CurrentIdentifierList.CreateIdentifier(NameSpaceInfo.NameSpace),
|
||||
0,nil,nil,ctnUseUnitNamespace);
|
||||
NewItem.UnitFileName := NameSpaceInfo.Filename;
|
||||
NewItem.IdentifierStartInUnitName := NameSpaceInfo.IdentifierStartInUnitName;
|
||||
CurrentIdentifierList.Add(NewItem);
|
||||
ANode:=FIDTTreeOfNamespaces.FindSuccessor(ANode);
|
||||
end;
|
||||
ANode:=FIDTTreeOfUnitFiles.FindSuccessor(ANode);
|
||||
end;
|
||||
finally
|
||||
FreeTreeOfUnitFiles(FIDTTreeOfUnitFiles);
|
||||
FreeTreeOfUnitFiles(FIDTTreeOfNamespaces);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2490,6 +2537,7 @@ var
|
||||
IdentStartXY: TCodeXYPosition;
|
||||
InFrontOfDirective: Boolean;
|
||||
ExprType: TExpressionType;
|
||||
IdentifierPath: string;
|
||||
|
||||
procedure CheckProcedureDeclarationContext;
|
||||
var
|
||||
@ -2551,6 +2599,18 @@ begin
|
||||
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',
|
||||
@ -2560,8 +2620,8 @@ begin
|
||||
{$ENDIF}
|
||||
GatherContext:=CreateFindContext(Self,CursorNode);
|
||||
CurrentIdentifierList.NewMemberVisibility:=GetClassVisibility(CursorNode);
|
||||
if CursorNode.Desc in [ctnUsesSection,ctnUseUnit] then begin
|
||||
GatherUnitNames;
|
||||
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
|
||||
|
||||
@ -1993,6 +1993,7 @@ function TPascalParserTool.ReadUsesSection(ExceptionOnError: boolean): boolean;
|
||||
}
|
||||
var
|
||||
IsUses: Boolean;
|
||||
LastUnitNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
IsUses:=CurNode.Desc=ctnUsesSection;
|
||||
@ -2016,8 +2017,14 @@ begin
|
||||
CurNode.Desc:=ctnUseUnit;
|
||||
repeat
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
CreateChildNode;
|
||||
LastUnitNode := CurNode;
|
||||
CurNode.Desc:=ctnUseUnitClearName;
|
||||
CurNode.EndPos:=CurNode.Parent.EndPos;
|
||||
EndChildNode;
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafPoint then break;
|
||||
LastUnitNode.Desc:=ctnUseUnitNamespace;
|
||||
ReadNextAtom;
|
||||
AtomIsIdentifierSaveE;
|
||||
until false;
|
||||
|
||||
@ -933,6 +933,12 @@ begin
|
||||
ShowNode:=false;
|
||||
end;
|
||||
|
||||
//don't show child nodes of ctnUseUnit
|
||||
if (CodeNode.Desc=ctnUseUnit)
|
||||
then begin
|
||||
ShowChilds:=false;
|
||||
end;
|
||||
|
||||
// don't show subs
|
||||
if CodeNode.Desc in [ctnConstant,ctnIdentifier,ctnRangedArrayType,
|
||||
ctnOpenArrayType,ctnOfConstType,ctnRangeType,ctnTypeType,ctnFileType,
|
||||
|
||||
@ -322,12 +322,18 @@ begin
|
||||
s:='label';
|
||||
end;
|
||||
|
||||
ctnUnit, ctnUseUnit:
|
||||
ctnUnit, ctnUseUnitClearName:
|
||||
begin
|
||||
AColor:=clBlack;
|
||||
s:='unit';
|
||||
end;
|
||||
|
||||
ctnUseUnitNamespace:
|
||||
begin
|
||||
AColor:=clBlack;
|
||||
s:='namespace';
|
||||
end;
|
||||
|
||||
ctnNone:
|
||||
if iliKeyword in IdentItem.Flags then begin
|
||||
AColor:=clBlack;
|
||||
@ -544,13 +550,29 @@ function FindUnitName(IdentList: TIdentifierList;
|
||||
IdentItem: TIdentifierListItem): string;
|
||||
var
|
||||
CodeBuf: TCodeBuffer;
|
||||
LastPointPos: Integer;
|
||||
begin
|
||||
Result:=IdentItem.Identifier;
|
||||
CodeBuf:=CodeToolBoss.FindUnitSource(IdentList.StartContextPos.Code,Result,'');
|
||||
if CodeBuf=nil then exit;
|
||||
Result:=CodeToolBoss.GetSourceName(CodeBuf,true);
|
||||
if IdentItem is TUnitNameSpaceIdentifierListItem then
|
||||
begin
|
||||
CodeBuf:=CodeToolBoss.FindFile(TUnitNameSpaceIdentifierListItem(IdentItem).UnitFileName);
|
||||
if CodeBuf=nil then Exit;
|
||||
Result:=CodeToolBoss.GetSourceName(CodeBuf,true);
|
||||
Result:=Copy(CodeToolBoss.GetSourceName(CodeBuf,true), TUnitNameSpaceIdentifierListItem(IdentItem).IdentifierStartInUnitName, Length(IdentItem.Identifier));
|
||||
end else
|
||||
begin
|
||||
CodeBuf:=CodeToolBoss.FindUnitSource(IdentList.StartContextPos.Code,Result,'');
|
||||
if CodeBuf=nil then Exit;
|
||||
Result:=CodeToolBoss.GetSourceName(CodeBuf,true);
|
||||
end;
|
||||
if Result='' then
|
||||
Result:=IdentItem.Identifier;
|
||||
Result:=IdentItem.Identifier
|
||||
else
|
||||
begin
|
||||
LastPointPos := LastDelimiter('.', Result);
|
||||
if LastPointPos > 0 then
|
||||
Result := Copy(Result, LastPointPos+1, High(Integer));
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetIdentCompletionValue(aCompletion : TSynCompletion;
|
||||
@ -617,7 +639,7 @@ begin
|
||||
IsReadOnly:=IdentItem.IsPropertyReadOnly;
|
||||
end;
|
||||
|
||||
ctnUnit, ctnPackage, ctnLibrary:
|
||||
ctnUnit, ctnPackage, ctnLibrary, ctnUseUnitNamespace:
|
||||
ValueType:=icvUnitName;
|
||||
end;
|
||||
|
||||
@ -739,7 +761,7 @@ begin
|
||||
end;
|
||||
|
||||
if CodeToolsOpts.IdentComplAddSemicolon and
|
||||
(IdentItem.GetDesc=ctnUseUnit) and (AddChar<>'.') and
|
||||
(IdentItem.GetDesc in [ctnUseUnitNamespace,ctnUseUnitClearName]) and (AddChar<>'.') and
|
||||
not IdentList.StartUpAtomBehindIs('.')//check if there is already a point
|
||||
then
|
||||
Result+='.';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user