paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-05 00:37:11 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: identifier completion: when creating an override hide higher visibility members

Browse Source 
git-svn-id: trunk@37632 -
This commit is contained in:
mattias 2012-06-12 12:12:03 +00:00
parent e711cf6069
commit 2f0a0b9f8e
2 changed files with 43 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
components/codetools/identcompletiontool.pas
View File

@ -198,6 +198,7 @@ type
TIdentifierList = class
private
FContext: TFindContext;
FNewMemberVisibility: TCodeTreeNodeDesc;
FContextFlags: TIdentifierListContextFlags;
FStartAtom: TAtomPosition;
FStartAtomBehind: TAtomPosition;
@ -214,7 +215,6 @@ type
FIdentSearchItem: TIdentifierListSearchItem;
FPrefix: string;
FStartContext: TFindContext;
procedure SetContextFlags(const AValue: TIdentifierListContextFlags);
procedure SetHistory(const AValue: TIdentifierHistoryList);
procedure UpdateFilteredList;
function GetFilteredItems(Index: integer): TIdentifierListItem;
@ -237,7 +237,9 @@ type
public
property Context: TFindContext read FContext write FContext;
property ContextFlags: TIdentifierListContextFlags
read FContextFlags write SetContextFlags;
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;
@ -290,7 +292,6 @@ type
//----------------------------------------------------------------------------
{ TCodeContextInfo }
{ TCodeContextInfoItem }
@ -304,6 +305,8 @@ type
destructor Destroy; override;
end;
{ TCodeContextInfo }
TCodeContextInfo = class
private
FEndPos: integer;
@ -556,13 +559,6 @@ begin
FHistory:=AValue;
end;
procedure TIdentifierList.SetContextFlags(
const AValue: TIdentifierListContextFlags);
begin
if FContextFlags=AValue then exit;
FContextFlags:=AValue;
end;
function TIdentifierList.GetFilteredItems(Index: integer): TIdentifierListItem;
begin
UpdateFilteredList;
@ -600,6 +596,7 @@ var
begin
fContextFlags:=[];
fContext:=CleanFindContext;
FNewMemberVisibility:=ctnNone;
FStartBracketLvl:=0;
fStartContext:=CleanFindContext;
fStartContextPos.Code:=nil;
@ -902,15 +899,26 @@ begin
end;
end else begin
// identifier is in another unit
if (FoundContext.Node.Parent<>nil) then begin
case FoundContext.Node.Parent.Desc of
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 (CurrentIdentifierList.Context.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
//debugln(['TIdentCompletionTool.CollectAllIdentifiers skipping member, because it would downgrade: ',dbgstr(FoundContext.Tool.ExtractNode(FoundContext.Node,[]),1,30)]);
exit;
end;
case Node.Desc of
ctnClassPrivate:
begin
// skip private definitions in other units
if (FoundContext.Node.Desc=ctnProperty) then begin
// private property: maybe the visibility was raised => continue
//debugln('TIdentCompletionTool.CollectAllIdentifiers MAYBE Private made Public '+StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)));
end;
exit;
end;
ctnClassProtected:
@ -2256,6 +2264,7 @@ begin
' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos));
{$ENDIF}
GatherContext:=CreateFindContext(Self,CursorNode);
CurrentIdentifierList.NewMemberVisibility:=GetClassVisibility(CursorNode);
if CursorNode.Desc in [ctnUsesSection,ctnUseUnit] then begin
GatherUnitNames;
MoveCursorToCleanPos(IdentEndPos);

18
components/codetools/pascalreadertool.pas
View File

@ -163,6 +163,7 @@ type
NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
function FindLastClassSection(ClassNode: TCodeTreeNode;
NodeDesc: TCodeTreeNodeDesc): TCodeTreeNode;
function GetClassVisibility(Node: TCodeTreeNode): TCodeTreeNodeDesc;
function FindClassNodeInInterface(const AClassName: string;
IgnoreForwards, IgnoreNonForwards, ErrorOnNotFound: boolean): TCodeTreeNode;
function FindClassNodeInUnit(const AClassName: string;
@ -1860,6 +1861,23 @@ begin
Result:=Result.PriorBrother;
end;
function TPascalReaderTool.GetClassVisibility(Node: TCodeTreeNode
): TCodeTreeNodeDesc;
begin
Result:=ctnNone;
if Node=nil then exit;
if Node.Desc=ctnProcedureHead then
Node:=Node.Parent;
if not (Node.Desc in AllClassSections) then begin
Node:=Node.Parent;
if Node=nil then exit;
end;
if Node.Desc in AllClassSubSections then
Node:=Node.Parent;
if Node.Desc in AllClassBaseSections then
Result:=Node.Desc;
end;
function TPascalReaderTool.FindClassNodeInInterface(
const AClassName: string; IgnoreForwards, IgnoreNonForwards,
ErrorOnNotFound: boolean): TCodeTreeNode;