paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 14:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

Revert the Codetools support of dotted names commit (issue #40596). It broke unit tests.

Browse Source
This commit is contained in:
Juha 2024-02-03 07:31:18 +02:00
parent 2e28bd8b6d
commit 34342f269f
9 changed files with 94 additions and 383 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/codetools/basiccodetools.pas
View File

@ -107,8 +107,7 @@ procedure GetIdentStartEndAtPosition(const Source:string; Position:integer;
out IdentStart,IdentEnd:integer);
function GetIdentStartPosition(const Source:string; Position:integer): integer;
function GetIdentLen(Identifier: PChar): integer;
function GetIdentifier(Identifier: PChar; const aSkipAmp: Boolean = True;
const IsDottedIdent: Boolean = False): string;
function GetIdentifier(Identifier: PChar; const aSkipAmp: Boolean = True): string;
function FindNextIdentifier(const Source: string; StartPos, MaxPos: integer): integer;
function FindNextIdentifierSkipStrings(const Source: string;
StartPos, MaxPos: integer): integer;
@ -1835,12 +1834,13 @@ begin
IdentEnd:=IdentStart;
end;
function GetIdentStartPosition(const Source: string; Position: integer): integer;
function GetIdentStartPosition(const Source: string; Position: integer
): integer;
begin
Result:=Position;
if (Result<1) or (Result>length(Source)+1) then exit;
while (Result>1)
and (IsDottedIdentChar[Source[Result-1]]) do //+dotted
and (IsIdentChar[Source[Result-1]]) do
dec(Result);
while (Result<Position)
and (not IsIdentStartChar[Source[Result]]) do
@ -4823,10 +4823,8 @@ begin
+'Actual: '+dbgstr(Actual,1,d-1)+'|'+dbgstr(Actual,d,length(Actual));
end;
function GetIdentifier(Identifier: PChar; const aSkipAmp: Boolean;
const IsDottedIdent: Boolean): string;
var
len: integer;
function GetIdentifier(Identifier: PChar; const aSkipAmp: Boolean): string;
var len: integer;
begin
if (Identifier=nil) then begin
Result:='';
@ -4841,10 +4839,7 @@ begin
else
inc(len);
end;
if not IsDottedIdent then
while (IsIdentChar[Identifier[len]]) do inc(len)
else
while (IsDottedIdentChar[Identifier[len]]) do inc(len);
while (IsIdentChar[Identifier[len]]) do inc(len);
SetLength(Result,len);
if len>0 then
Move(Identifier[0],Result[1],len);
@ -4852,7 +4847,8 @@ begin
Result:='';
end;
function FindNextIdentifier(const Source: string; StartPos, MaxPos: integer): integer;
function FindNextIdentifier(const Source: string; StartPos, MaxPos: integer
): integer;
begin
Result:=StartPos;
while (Result<=MaxPos) and (not IsIdentStartChar[Source[Result]]) do

93
components/codetools/codetoolmanager.pas
View File

@ -2597,100 +2597,19 @@ end;
function TCodeToolManager.GetIdentifierAt(Code: TCodeBuffer; X, Y: integer; out
Identifier: string): boolean;
var
CleanPos, cleanPosAmd, i: integer;
canBeDotted: boolean;
CodeTool: TCodeTool;
CaretXY: TCodeXYPosition;
CodeNode: TCodeTreeNode;
CleanPos: integer;
begin
Result:=false;
Identifier:='';
canBeDotted:=false;
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.GetIdentifierAt A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
{$ENDIF}
Code.LineColToPosition(Y,X,CleanPos);
if (CleanPos>0) and (CleanPos<=Code.SourceLength) then begin
i:=CleanPos;
repeat
while (i>1) and isIdentChar[Code.Source[i-1]] do
dec(i);
if Code.Source[i-1]='.' then begin
canBeDotted:=true;
dec(i);
end;
until (i<=1) or (not isIdentChar[Code.Source[i-1]]);
if not isIdentStartChar[Code.Source[i]] then exit;
if not canBeDotted then begin
i:=CleanPos;
repeat
while (i<Code.SourceLength) and isIdentChar[Code.Source[i]] do
inc(i);
if Code.Source[i]='.' then begin
canBeDotted:=true;
inc(i);
end;
until canBeDotted or ((not isIdentChar[Code.Source[i]]) or (i>=Code.SourceLength));
end;
if not canBeDotted then begin
Identifier:=GetIdentifier(@Code.Source[CleanPos]);
Result:=true;
end else begin //now problematic cases
//1. inside single dotted identifier?
//2. inside [multiple] concatenation of
//[[dotted] identifier + '.' + type/field/property/method/procedure/function ..]?
// no assumptions should be taken - everything possible, then use parsed code tree
CodeTool:=nil;
CaretXY:=CleanCodeXYPosition;
CaretXY.Code:=Code;
CaretXY.X:=X;
CaretXY.Y:=Y;
CodeNode:=nil;
if CodeToolBoss.Explore(Code,CodeTool,true) then
if CodeTool<>nil then begin
CodeTool.CaretToCleanPos(CaretXY,CleanPosAmd);
CodeNode:=CodeTool.FindDeepestNodeAtPos(CleanPosAmd,false);
end;
if (CodeNode<>nil) and (CodeNode.Parent<>nil) then begin
if CodeNode.IsDottedIdentParent then begin
CleanPosAmd:= CodeNode.StartPos;
if (CleanPosAmd<1) or (CleanPosAmd >= Code.SourceLength) then exit;
Identifier:=GetDottedIdentifier(@Code.Source[CleanPosAmd]);
Result:=true;
end else
if CodeNode.IsDottedIdentChild then begin
CleanPosAmd:= CodeNode.Parent.StartPos;
if (CleanPosAmd<1) or (CleanPosAmd >= Code.SourceLength) then exit;
Identifier:=GetDottedIdentifier(@Code.Source[CleanPosAmd]);
Result:=true;
end else begin
if (CodeNode.StartPos<=CleanPosAmd) and (CodeNode.EndPos>CleanPosAmd)
then begin
if (CodeNode.ChildCount=1) and (CodeNode.LastChild.Desc=ctnIdentifier)
then begin //e.g. 'a:dotted.|unit1.TType;' - where | = CleanPosAmd
i:=CleanPosAmd;
repeat
while (i>1) and isIdentChar[Code.Source[i-1]] do
dec(i);
if Code.Source[i-1]='.' then begin
dec(i);
end;
until (i<=1) or (not isIdentChar[Code.Source[i-1]]);
if IsIdentStartChar[Code.Source[i]] then begin
Identifier:=GetDottedIdentifier(@Code.Source[i]);
Result:=true;
end;
end;
end;
end;
end;
end;
Identifier:=GetIdentifier(@Code.Source[CleanPos]);
Result:=true;
end else begin
Identifier:='';
Result:=false;
end;
end;

34
components/codetools/codetree.pas
View File

@ -313,8 +313,6 @@ type
function GetLastNode: TCodeTreeNode;
function DescAsString: string;
function FindOwner: TObject;
function IsDottedIdentParent: boolean;
function IsDottedIdentChild: boolean;
procedure Clear;
constructor Create;
procedure ConsistencyCheck;
@ -978,38 +976,6 @@ begin
Result:=FindOwnerOfCodeTreeNode(Self);
end;
function TCodeTreeNode.IsDottedIdentParent: boolean;
begin // TRUE means: from this node.StartPos dotted Ident can be read,
//note that node.EndPos-1 for (Desc = ctnSrcName) should be ';' and for
//(Desc = ctnUseUnit) should be ',' or ';'
Result:=false;
if (Desc in [ctnUseUnit]) and (ChildCount>1) then
Result:=true
else
if (Parent<>nil) and (Parent.Desc in [ctnUnit,ctnProgram,ctnPackage,ctnLibrary])
and (Desc = ctnSrcName) and (ChildCount>1) and (FirstChild.Desc=ctnIdentifier) then
//identifier can be dotted
// a solution can be change parsing (and write proper EndPos value) or as below
Result:=FirstChild.NextBrother.StartPos>FirstChild.EndPos+2;//'.'+';'
//without accessing Src[N] (clean source)
end;
function TCodeTreeNode.IsDottedIdentChild: boolean;
begin // TRUE means: from this node.Parent.StartPos dotted Ident can be read,
//note that node.Parent.EndPos-1 for (Parent.Desc = ctnSrcName) should be ';' and for
//(Parent.Desc = ctnUseUnit) should be ',' or ';'
Result:=false;
if (Parent<>nil) then begin
if (Desc in [ctnUseUnitNamespace, ctnUseUnitClearName]) and (Parent.ChildCount>1) then
Result:=true
else
if (Desc = ctnIdentifier) {and (Parent.Desc=ctnSrcName)} //WB - was too strict
and ((EndPos - StartPos)<(Parent.EndPos-Parent.StartPos-1)) then
Result:=true;
end;
end;
{ TCodeTree }
constructor TCodeTree.Create;

96
components/codetools/finddeclarationtool.pas
View File

@ -2405,7 +2405,19 @@ begin
DbgOut(' Parent="',CursorNode.Parent.DescAsString,'"');
Debugln;
{$ENDIF}
if (CursorNode.Desc in [ctnUseUnitNamespace,ctnUseUnitClearName]) 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;
BlockTopLine := NewTopLine;
CleanPosToCaret(CursorNode.EndPos, NewPos);
BlockBottomLine := 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,
@ -2972,15 +2984,13 @@ begin
if not UpAtomIs('USES') then
RaiseUsesExpected(20170421200506);
end else
if (UsesNode.Desc in [ctnUseUnitNamespace,ctnUseUnitClearName]) then
if (UsesNode.Desc = ctnUseUnitClearName) then
MoveCursorToNodeStart(UsesNode.Parent);
repeat
ReadNextAtom; // read name
if CurPos.StartPos>CleanPos then break;
if CurPos.Flag=cafSemicolon then break;
if CurPos.Flag=cafPoint then continue; //+dotted
ReadNextUsedUnit(UnitNamePos,UnitInFilePos);
if CleanPos<=CurPos.StartPos then begin
// cursor is on an used unit -> try to locate it
@ -3460,18 +3470,9 @@ begin
Node := Node.Parent;
case Node.Desc of
ctnIdentifier:
if Assigned(Node.Parent) then begin
if (Node.Parent.Desc = ctnProcedureHead) then
// function result
Result := 'var Result: ' + ExtractNode(Node, [])
else if Assigned(Node.Parent.Parent) and (Node.Parent.Parent.Desc = ctnSrcName) then
// source name,
//Node.Parent.Parent should be assigned but nobody promised that it always will be true
begin
//DebugLn(['Node.Parent.Parent.DescAsString = ', Node.Parent.Parent.DescAsString]);
Result := Node.Parent.Parent.DescAsString+': ' + GetDottedIdentifier(pchar(@Src[Node.Parent.StartPos]));
end;
end;
if Assigned(Node.Parent) and (Node.Parent.Desc = ctnProcedureHead) then
// function result
Result := 'var Result: ' + ExtractNode(Node, []);
ctnVarDefinition, ctnTypeDefinition, ctnConstDefinition,
ctnEnumIdentifier, ctnLabel, ctnGenericType:
@ -3682,7 +3683,16 @@ begin
end;
end;
ctnUseUnitNamespace,ctnUseUnitClearName:
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 ';
@ -4102,22 +4112,8 @@ begin
MoveCursorToCleanPos(Params.Identifier);
StartPos:=FindStartOfTerm(CurPos.StartPos,NodeTermInType(Params.ContextNode));
MoveCursorToCleanPos(Params.Identifier);
if Params.ContextNode.Desc in [ctnUseUnitNamespace,ctnUseUnitClearName] then
begin
EndPos:=Params.ContextNode.Parent.EndPos;
repeat
ReadNextAtom;
if CurPos.Flag=cafWord then
ReadNextAtom;
if CurPos.Flag=cafPoint then
continue;
break;
until CurPos.EndPos>= self.SrcLen;
end else begin
ReadNextAtom;
EndPos:=CurPos.EndPos;
end;
ReadNextAtom;
EndPos:=CurPos.EndPos;
if (Params.ContextNode.Desc=ctnIdentifier)
and (Params.ContextNode.Parent.Desc=ctnAttribParam) then begin
// parameters don't matter for the attribute name
@ -6567,23 +6563,17 @@ var
AnUnitName: String;
UnitInFilename: AnsiString;
Node: TCodeTreeNode;
IsDotted: boolean;
begin
if (not IsComment) then
UnitStartFound:=true;
IdentStartPos:=StartPos;
IdentEndPos:=IdentStartPos;
IsDotted:=IsDottedIdentifier(Identifier);
if not IsDotted then
while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do
inc(IdentEndPos)
else
while (IdentEndPos<=MaxPos) and (IsDottedIdentChar[Src[IdentEndPos]]) do
inc(IdentEndPos);
while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do
inc(IdentEndPos);
StartPos:=IdentEndPos;
//debugln(['ReadIdentifier ',CleanPosToStr(IdentStartPos,true),' ',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos),' ',CompareIdentifiers(PChar(Pointer(Identifier)),@Src[IdentStartPos])]);
if not Isdotted and (IdentEndPos-IdentStartPos<>length(Identifier)) then exit;
if CompareIdentifiers(PChar(Pointer(Identifier)),@Src[IdentStartPos])<>0 then exit;//dotted ready
if IdentEndPos-IdentStartPos<>length(Identifier) then exit;
if CompareIdentifiers(PChar(Pointer(Identifier)),@Src[IdentStartPos])<>0 then exit;
if IsComment and (SkipComments or (not UnitStartFound)) then exit;
{$IFDEF VerboseFindReferences}
debugln(['Identifier with same name found at: ',
@ -6599,11 +6589,6 @@ var
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(IdentStartPos,true);
//debugln(' CursorNode=',NodePathAsString(CursorNode),' Forward=',dbgs(CursorNode.SubDesc and ctnsForwardDeclaration));
if (CursorNode<>nil) and
(CursorNode.Desc in [ctnUseUnitNamespace,ctnUseUnitClearName]) and
(IdentStartPos=CursorNode.Parent.StartPos) then begin //found in uses clause
AddReference(IdentStartPos);
end else
if (DeclarationTool=Self)
and ((IdentStartPos=CleanDeclCursorPos) or (CursorNode=AliasDeclarationNode))
then begin
@ -6644,7 +6629,7 @@ var
//debugln(' Found=',dbgs(Found));
Node:=Params.NewNode;
if Found and (Node<>nil) and (Node.Parent<>nil) then begin
if Found and (Node<>nil) then begin
if ((Node.Desc=ctnUseUnit) or (Node.Parent.Desc=ctnUseUnit))
and (Params.NewCodeTool=Self) then begin
// identifier is a unit reference
@ -6835,12 +6820,7 @@ var
DeclarationTool.BuildTreeAndGetCleanPos(CursorPos,CleanDeclCursorPos);
DeclarationNode:=DeclarationTool.BuildSubTreeAndFindDeepestNodeAtPos(
CleanDeclCursorPos,true);
if not DeclarationNode.IsDottedIdentChild then
Identifier:=DeclarationTool.ExtractIdentifier(CleanDeclCursorPos)
else
Identifier:=DeclarationTool.ExtractDottedIdentifier(DeclarationNode.Parent.StartPos);
Identifier:=DeclarationTool.ExtractIdentifier(CleanDeclCursorPos);
if Identifier='' then begin
//debugln('FindDeclarationNode Identifier="',Identifier,'"');
exit;
@ -7253,7 +7233,7 @@ begin
ctnIdentifier:
if Node.Parent.Desc=ctnSrcName then
Result:=(Node.Parent.StartPos<=CleanPos) and (Node.Parent.EndPos>CleanPos);
Result:=true;
end;
end;
@ -9827,7 +9807,7 @@ var
Params.Flags:=Params.Flags+[fdfIgnoreUsedUnits];
if Assigned(Context.Node) and (Context.Node.Desc=ctnImplementation) then
Params.Flags:=Params.Flags+[fdfSearchInParentNodes];
if Assigned(Context.Node) and (Context.Node.Desc=ctnObjCClass) then
if Context.Node.Desc=ctnObjCClass then
Exclude(Params.Flags,fdfExceptionOnNotFound); // ObjCClass has predefined identifiers like 'alloc'
end;
@ -9837,7 +9817,7 @@ var
Include(Params.Flags,fdfIgnoreOverloadedProcs);
//debugln(['ResolveIdentifier ',IsEnd,' ',GetAtom(CurAtom),' ',Context.Node.DescAsString,' ',Context.Node.Parent.DescAsString,' ']);
if IsEnd and Assigned(Context.Node) and (Context.Node.Desc=ctnIdentifier) //check node<>nil
if IsEnd and (Context.Node.Desc=ctnIdentifier)
and (Context.Node.Parent.Desc=ctnAttribParam)
and ResolveAttribute(Context) then begin
exit;

46
components/codetools/identcompletiontool.pas
View File

@ -158,8 +158,7 @@ type
NewHasChilds: boolean; NewHistoryIndex: integer;
NewIdentifier: PChar; NewLevel: integer;
NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
NewDefaultDesc: TCodeTreeNodeDesc;
IsDottedIdent: boolean=false);
NewDefaultDesc: TCodeTreeNodeDesc);
function IsProcNodeWithParams: boolean;
function IsPropertyWithParams: boolean;
function IsPropertyReadOnly: boolean;
@ -1368,7 +1367,6 @@ var
ProtectedForeignClass: Boolean;
Lvl: LongInt;
HasLowerVisibility: Boolean;
IsDottedIdent: Boolean;
begin
// proceed searching ...
Result:=ifrProceedSearch;
@ -1540,38 +1538,15 @@ begin
ctnRecordCase:
Ident:=@FoundContext.Tool.Src[Params.NewCleanPos];
ctnIdentifier:
if (FoundContext.Tool=Self) and (FoundContext.Node.Parent<>nil) then begin
Ident:=@Src[FoundContext.Node.Parent.StartPos];
if (FoundContext.Node.Desc = ctnIdentifier) and
(FoundContext.Node.Parent.Desc = ctnSrcName) then begin
IsDottedIdent:=true;
Ident:=@Src[FoundContext.Node.Parent.StartPos];
end;
end;
ctnUseUnitNamespace,ctnUseUnitClearName:
if (FoundContext.Tool=Self) and (FoundContext.Node.Parent<>nil) then begin
Ident:=@Src[FoundContext.Node.Parent.StartPos];
if (FoundContext.Node.Parent.ChildCount=1) then
IsDottedIdent:=false //ctnUseUnitClearName only
else begin
if (FoundContext.Node.Parent.FirstChild = FoundContext.Node) then
IsDottedIdent:=true //first ctnUseUnitNamespace
else
Ident:=nil; //not first ctnUseUnitNamespace => mark to skip the node
//execution flow does not reache here as parsing "use unit" only once
//calls the function, let us leave it for safety if the rule changed
end;
if (FoundContext.Tool=Self) then begin
Ident:=@Src[FoundContext.Node.StartPos];
end;
ctnUnit,ctnProgram,ctnLibrary,ctnPackage: //WB
if (FoundContext.Tool=Self) and (FoundContext.Node.FirstChild<>nil) and
(FoundContext.Node.FirstChild.Desc=ctnSrcName) then begin
IsDottedIdent:=true;// undotted idents will be procedeed correctly anyway
//but dotted ones need it
Ident:=@Src[FoundContext.Node.FirstChild.StartPos];
end;
ctnUnit,ctnProgram,ctnLibrary,ctnPackage:
if (FoundContext.Tool=Self)
and GetSourceNamePos(NamePos) then
Ident:=@Src[NamePos.StartPos];
end;
if Ident=nil then exit;
@ -1584,8 +1559,7 @@ begin
Lvl,
FoundContext.Node,
FoundContext.Tool,
ctnNone,
IsDottedIdent);
ctnNone);
//Add the '&' character to prefixed identifiers
if (Ident^='&') and (IsIdentStartChar[Ident[1]]) then
@ -4321,12 +4295,12 @@ constructor TIdentifierListItem.Create(
NewCompatibility: TIdentifierCompatibility; NewHasChilds: boolean;
NewHistoryIndex: integer; NewIdentifier: PChar; NewLevel: integer;
NewNode: TCodeTreeNode; NewTool: TFindDeclarationTool;
NewDefaultDesc: TCodeTreeNodeDesc; IsDottedIdent: boolean);
NewDefaultDesc: TCodeTreeNodeDesc);
begin
Compatibility:=NewCompatibility;
if NewHasChilds then Include(FLags,iliHasChilds);
HistoryIndex:=NewHistoryIndex;
Identifier:=GetIdentifier(NewIdentifier,True,IsDottedIdent);
Identifier:=GetIdentifier(NewIdentifier);
Level:=NewLevel;
Tool:=NewTool;
Node:=NewNode;

47
components/codetools/keywordfunclists.pas
View File

@ -183,7 +183,6 @@ var
function UpperCaseStr(const s: string): string;
function IsUpperCaseStr(const s: string): boolean;
function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
function CompareIdentifiersAtoms(Identifier1, Identifier2: PChar): integer;
function CalcMemSize: PtrUInt;
@ -222,50 +221,10 @@ end;
function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
begin
if (Identifier1<>nil) and IsIdentStartChar[Identifier1[0]] then begin
if (Identifier2<>nil) and IsIdentStartChar[Identifier2[0]] then begin
while (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) do begin
if (IsDottedIdentChar[Identifier1[0]]) then begin //+ dotted feature
inc(Identifier1);
inc(Identifier2);
end else begin
Result:=0; // for example 'aaA;' 'aAa;'
exit;
end;
end;
if (IsIdentChar[Identifier1[0]]) then begin
if (IsIdentChar[Identifier2[0]]) then begin
if UpChars[Identifier1[0]]>UpChars[Identifier2[0]] then
Result:=-1 // for example 'aab' 'aaa'
else
Result:=1; // for example 'aaa' 'aab'
end else begin
Result:=-1; // for example 'aaa' 'aa;'
end;
end else begin
if (IsIdentChar[Identifier2[0]]) then
Result:=1 // for example 'aa;' 'aaa'
else
Result:=0; // for example 'aa;' 'aa,'
end;
end else begin
Result:=-1; // for example 'aaa' nil
end;
end else begin
if (Identifier1<>nil) then begin
if (Identifier2<>nil) then begin
Result:=1; // for example nil 'bbb'
end else begin
Result:=0; // for example nil nil
end;
end;
end;
function CompareIdentifiersAtoms(Identifier1, Identifier2: PChar): integer;
begin
if (Identifier1<>nil) and IsIdentStartChar[Identifier1[0]] then begin
if (Identifier2<>nil) and IsIdentStartChar[Identifier2[0]] then begin
while (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) do begin
if (IsIdentChar[Identifier1[0]]) then begin //not dotted feature
if (IsIdentChar[Identifier1[0]]) then begin
inc(Identifier1);
inc(Identifier2);
end else begin
@ -604,7 +563,7 @@ begin
i:=FBucketStart[i];
if i>=0 then begin
repeat
if CompareIdentifiersAtoms(PChar(@FItems[i].KeyWord[1]),Identifier)=0 then begin
if CompareIdentifiers(PChar(@FItems[i].KeyWord[1]),Identifier)=0 then begin
if Assigned(FItems[i].DoIt) then
Result:=FItems[i].DoIt()
else

9
components/codetools/pascalparsertool.pas
View File

@ -775,9 +775,8 @@ begin
repeat
ReadNextAtom; // read source name
// program and library can use keywords
if (aNameSpace='') and
((CurPos.Flag<>cafWord) or
(CurSection in [ctnProgram,ctnPackage,ctnLibrary,ctnUnit])) then //+dotted
if (CurPos.Flag<>cafWord)
or (CurSection in [ctnUnit,ctnPackage]) then
AtomIsIdentifierSaveE(20180411193958);
if aNameSpace='' then begin
CreateChildNode;
@ -799,8 +798,8 @@ begin
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
end;
if CurSection in [ctnProgram,ctnPackage,ctnLibrary,ctnUnit] then
AddedNameSpace:=''; //aNameSpace; // to kill namespaces!
if CurSection in [ctnProgram,ctnLibrary,ctnPackage] then
AddedNameSpace:=aNameSpace;
end;
ScannedRange:=lsrSourceName;
if ord(Range)<=ord(ScannedRange) then exit;

38
ide/sourceeditprocs.pas
View File

@ -514,42 +514,26 @@ begin
end;
end;
ctnProgram,ctnPackage,ctnLibrary:
begin
if UseImages then
ImageIndexCC := IDEImages.LoadImage('cc_unit')
else begin
if ItemNode<>nil then begin
AColor:=clOlive;
s:=LowerCase(ItemNode.DescAsString);
end else begin
AColor:=clGray;
s:='';
end;
end;
end;
ctnUnit, ctnUseUnitClearName:
begin
if UseImages then
ImageIndexCC := IDEImages.LoadImage('cc_unit')
else begin
AColor:=clBlack;
s:='unit';
end;
else
begin
AColor:=clBlack;
s:='unit';
end;
end;
ctnUseUnitNamespace:
begin
if (IdentItem.Node<>nil) and (IdentItem.Node.Parent<>nil) and
(IdentItem.Node.Parent.desc in [ctnUseUnit]) then begin
if UseImages then
ImageIndexCC := IDEImages.LoadImage('cc_unit')
else begin
if UseImages then
ImageIndexCC := IDEImages.LoadImage('cc_namespace')
else
begin
AColor:=clBlack;
s:='unit';
end;
end;
s:='namespace';
end;
end;
ctnWord:

92
ide/sourcefilemanager.pas
View File

@ -8363,14 +8363,10 @@ var
OldCode: TCodeBuffer;
OldCodeCreated: Boolean;
PascalReferences: TAVLTree;
i: Integer;
MsgResult: TModalResult;
OnlyEditorFiles: Boolean;
aFilename: String;
DeclXY: TPoint;
CodeTool: TCodeTool;
CaretXY: TCodeXYPosition;
CodeNode: TCodeTreeNode;
CleanPosAmd, i:integer;
begin
// compare unitnames case sensitive, maybe only the case changed
if (CompareFilenames(OldFilename,NewFilename)=0) and (OldUnitName=NewUnitName) then
@ -8397,46 +8393,24 @@ begin
end else begin
// get owners of unit
OwnerList:=PkgBoss.GetOwnersOfUnit(NewFilename);
if OwnerList=nil then exit(mrOk);
PkgBoss.ExtendOwnerListWithUsedByOwners(OwnerList);
ReverseList(OwnerList);
//if OwnerList=nil then exit(mrOk); // this causes out of the business, why?
if OwnerList<>nil then begin
PkgBoss.ExtendOwnerListWithUsedByOwners(OwnerList);
ReverseList(OwnerList);
// get source files of packages and projects
ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
try
if ExtraFiles<>nil then
Files.AddStrings(ExtraFiles);
finally
ExtraFiles.Free;
end;
// get source files of packages and projects
ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
try
if ExtraFiles<>nil then
Files.AddStrings(ExtraFiles);
finally
ExtraFiles.Free;
end;
// Files list here was empty, so the below
if LazarusIDE.ActiveProject <> nil then begin
if OwnerList=nil then
OwnerList:=TFPList.Create;
OwnerList.Clear;
OwnerList.Add(LazarusIDE.ActiveProject);
ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
try
if ExtraFiles<>nil then
Files.AddStrings(ExtraFiles);
//Files.Add(OldFilename); // here can be references to unit itself in code or comments
finally
ExtraFiles.Free;
end;
end;
CleanUpFileList(Files);
end;
for i:=Files.Count-1 downto 0 do begin
if (CompareFilenames(Files[i],OldFilename)=0)
or (CompareFilenames(Files[i],NewFilename)=0) then
Files.Delete(i);
end;
//DebugLn(['ReplaceUnitUse ',Files.Text]);
// commit source editor to codetools
@ -8451,50 +8425,11 @@ begin
end;
// search pascal source references
//Result:=GatherUnitReferences(Files,OldCode,false,IgnoreErrors,true,PascalReferences); //WB - commented out
//WB ===
CodeTool:=nil;
CaretXY.X:=1;
CaretXY.Y:=1;
CaretXY.Code:=OldCode;
CodeNode:=nil;
if CodeToolBoss.Explore(OldCode,CodeTool,false,true{= interface only}) then
if CodeTool<>nil then begin
CodeTool.CaretToCleanPos(CaretXY,CleanPosAmd);
CodeNode:=CodeTool.FindDeepestNodeAtPos(CleanPosAmd,false{= no exceptions});
end;
if CodeNode<>nil then begin
//explore tree and find unit SourceName StartPos
CodeNode:=CodeNode.GetRoot;
if (CodeNode.Desc in [ctnProgram, ctnPackage, ctnLibrary, ctnUnit]) and
(CodeNode.FirstChild<>nil) and (CodeNode.FirstChild.Desc=ctnSrcName)
then begin
CleanPosAmd:=CodeNode.FirstChild.StartPos;
if CodeTool.CleanPosToCaret(CleanPosAmd,CaretXY) then begin
DeclXY.X:=CaretXY.X;
DeclXY.Y:=CaretXY.Y;
end else begin
DeclXY.X:=0;
DeclXY.Y:=0;
end;
end else begin
DeclXY.X:=0;
DeclXY.Y:=0;
end;
end else begin
DeclXY.X:=0;
DeclXY.Y:=0;
end;
Result:=GatherIdentifierReferences(Files, OldCode,DeclXY, True, PascalReferences);
//===
Result:=GatherUnitReferences(Files,OldCode,false,IgnoreErrors,true,PascalReferences);
if (not IgnoreErrors) and (not Quiet) and (CodeToolBoss.ErrorMessage<>'') then
MainIDE.DoJumpToCodeToolBossError;
if Result<>mrOk then begin
//debugln('ReplaceUnitUse GatherUnitReferences failed');
debugln('ReplaceUnitUse GatherIdentifierReferences failed'); //WB - now as Identifiers
debugln('ReplaceUnitUse GatherUnitReferences failed');
exit;
end;
@ -8519,7 +8454,6 @@ begin
exit;
end;
end;
if not CodeToolBoss.RenameIdentifier(PascalReferences,OldUnitName,NewUnitName,
Nil,Nil,True) then
begin