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

IDE: loadlfm: check for ambiguous classes, heuristics to resolve ambiguous classes

Browse Source
This commit is contained in:
mattias 2023-04-12 18:57:08 +02:00
parent abab3ed287
commit 16eea4aacd
7 changed files with 332 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/codetools/codetoolmanager.pas
View File

@ -840,7 +840,8 @@ type
const AClassName, AVarName: string;
ErrorOnClassNotFound: boolean): boolean;
function GatherPublishedVarTypes(Code: TCodeBuffer; const AClassName: string;
out VarNameToType: TStringToStringTree): boolean;
out VarNameToType: TStringToStringTree // VarName to NS.UnitName/ClassType
): boolean;
function AddPublishedVariable(Code: TCodeBuffer;
const AClassName,VarName, VarType: string): boolean;
function RemovePublishedVariable(Code: TCodeBuffer;

4
components/codetools/stdcodetools.pas
View File

@ -4621,8 +4621,8 @@ begin
if aContext.Node.Desc=ctnClass then
VarType:=aContext.Tool.ExtractClassName(aContext.Node,false);
CurUnitName:=aContext.Tool.GetSourceName(false);
// unitname.vartype
NewType:=CurUnitName+'.'+VarType;
// unitname/vartype
NewType:=CurUnitName+'/'+VarType;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Resolved: "',VarType,'" = "',NewType,'"']);
SimpleTypes[VarType]:=NewType;
finally

3
components/ideintf/unitresources.pas
View File

@ -42,7 +42,8 @@ type
PascalBuffer, LFMBuffer: TObject; // TCodeBuffer
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string;
out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
out MissingClasses: TStrings;// e.g. 'TMyFrame' or 'MyUnit.TMyFrame'
out AmbiguousClasses: TFPList // list of TRegisteredComponent
): TModalResult; virtual; abstract;
class function Priority: integer; virtual; // higher priority is tested first
class function DefaultComponentClass: TComponentClass; virtual;

61
examples/xmlresource/xmlresourcefile.pas
View File

@ -8,7 +8,7 @@ uses
Classes, Controls, SysUtils, RtlConsts,
LCLMemManager, forms, LazFileUtils,
dom, XMLRead, XMLWrite,
ProjectIntf, UnitResources, CodeCache;
ProjectIntf, UnitResources, CodeCache, CodeToolManager;
type
@ -28,7 +28,8 @@ type
class function CreateWriter(s: TStream; var DestroyDriver: boolean): TWriter; override;
class function QuickCheckResourceBuffer(PascalBuffer, LFMBuffer: TObject;
out LFMType, LFMComponentName, LFMClassName: string; out
LCLVersion: string; out MissingClasses: TStrings): TModalResult; override;
LCLVersion: string; out MissingClasses: TStrings;
out AmbiguousClasses: TFPList): TModalResult; override;
end;
{ TXMLReader }
@ -98,16 +99,17 @@ type
private
procedure CreateXML;
public
constructor Create(Stream: TStream; BufSize: Integer);
constructor Create(Stream: TStream; {%H-}BufSize: Integer);
destructor Destroy; override;
procedure BeginCollection; override;
procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
ChildPos: Integer); override;
procedure BeginComponent(Component: TComponent; {%H-}Flags: TFilerFlags;
{%H-}ChildPos: Integer); override;
procedure BeginList; override;
procedure EndList; override;
procedure BeginProperty(const PropName: String); override;
procedure EndProperty; override;
procedure WriteSignature; override;
//Please don't use write, better use WriteBinary whenever possible
procedure Write(const Buffer; Count: Longint); override;
@ -128,8 +130,6 @@ type
procedure WriteFloat(const Value: Extended); override;
procedure WriteSingle(const Value: Single); override;
procedure WriteDate(const Value: TDateTime); override;
end;
{ TFileDescPascalUnitWithXMLResource }
@ -139,7 +139,7 @@ type
constructor Create; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function GetImplementationSource(const Filename, SourceName, ResourceName: string): string; override;
function GetImplementationSource(const Filename, {%H-}SourceName, {%H-}ResourceName: string): string; override;
end;
@ -226,8 +226,8 @@ begin
inc(FListLevel,2);
ANewNode := FXMLDoc.CreateElement('object');
ANewNode.AttribStrings['type'] := Component.ClassName;
ANewNode.AttribStrings['name'] := Component.Name;
ANewNode.AttribStrings['type'] := Component.ClassName{%H-};
ANewNode.AttribStrings['name'] := Component.Name{%H-};
if not assigned(FObjNode) then
FXMLDoc.AppendChild(ANewNode)
else
@ -259,7 +259,7 @@ procedure TXMLObjectWriter.BeginProperty(const PropName: String);
begin
FCurNode := FXMLDoc.CreateElement('property');
FObjNode.AppendChild(FCurNode);
FCurNode.AttribStrings['name'] := PropName;
FCurNode.AttribStrings['name'] := PropName{%H-};
end;
procedure TXMLObjectWriter.EndProperty;
@ -267,14 +267,19 @@ begin
// Do nothing
end;
procedure TXMLObjectWriter.Write(const Buffer; Count: Longint);
procedure TXMLObjectWriter.WriteSignature;
begin
end;
procedure TXMLObjectWriter.Write(const Buffer; Count: Longint);
begin
raise Exception.Create('TXMLObjectWriter.Write');
end;
procedure TXMLObjectWriter.WriteBinary(const Buffer; Count: LongInt);
begin
raise Exception.Create('TXMLObjectWriter.WriteBinary');
end;
procedure TXMLObjectWriter.WriteBoolean(Value: Boolean);
@ -293,7 +298,7 @@ end;
procedure TXMLObjectWriter.WriteCurrency(const Value: Currency);
begin
raise Exception.Create('TXMLObjectWriter.WriteCurrency');
end;
procedure TXMLObjectWriter.WriteIdent(const Ident: string);
@ -322,7 +327,7 @@ end;
procedure TXMLObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
begin
raise Exception.Create('TXMLObjectWriter.WriteSet');
end;
procedure TXMLObjectWriter.WriteString(const Value: String);
@ -333,32 +338,32 @@ end;
procedure TXMLObjectWriter.WriteWideString(const Value: WideString);
begin
raise Exception.Create('TXMLObjectWriter.WriteWideString');
end;
procedure TXMLObjectWriter.WriteUnicodeString(const Value: UnicodeString);
begin
raise Exception.Create('TXMLObjectWriter.WriteUnicodeString');
end;
procedure TXMLObjectWriter.WriteVariant(const VarValue: Variant);
begin
raise Exception.Create('TXMLObjectWriter.WriteVariant');
end;
procedure TXMLObjectWriter.WriteFloat(const Value: Extended);
begin
//
raise Exception.Create('TXMLObjectWriter.WriteFloat');
end;
procedure TXMLObjectWriter.WriteSingle(const Value: Single);
begin
//
raise Exception.Create('TXMLObjectWriter.WriteSingle');
end;
procedure TXMLObjectWriter.WriteDate(const Value: TDateTime);
begin
//
raise Exception.Create('TXMLObjectWriter.WriteDate');
end;
{ TXMLWriter }
@ -580,7 +585,6 @@ class procedure TXMLUnitResourcefileFormat.QuickReadXML(s: TStream; out
AComponentName, AClassName, ALCLVersion: string);
var
AXMLDocument: TXMLDocument;
ms: TStringStream;
ObjNode: TDOMNode;
begin
ReadXMLFile(AXMLDocument, s);
@ -609,7 +613,8 @@ var
cb: TCodeBuffer;
nx,ny,nt: integer;
begin
// result := CodeToolBoss.FindResourceDirective(Source as TCodeBuffer,1,1,cb,nx,ny,nt, ResourceDirectiveFilename,false);
result := CodeToolBoss.FindResourceDirective(Source as TCodeBuffer,
1,1,cb,nx,ny,nt, '*.xml',false);
end;
class function TXMLUnitResourcefileFormat.GetUnitResourceFilename(
@ -661,21 +666,21 @@ end;
class function TXMLUnitResourcefileFormat.QuickCheckResourceBuffer(
PascalBuffer, LFMBuffer: TObject; out LFMType, LFMComponentName,
LFMClassName: string; out LCLVersion: string; out MissingClasses: TStrings
): TModalResult;
LFMClassName: string; out LCLVersion: string; out MissingClasses: TStrings;
out AmbiguousClasses: TFPList): TModalResult;
var
ms: TStringStream;
begin
Result:=mrOk;
LFMType:='unknown';
MissingClasses := nil;
AmbiguousClasses:=nil;
ms := TStringStream.Create((LFMBuffer as TCodeBuffer).Source);
try
QuickReadXML(ms, LFMComponentName, LFMClassName, LCLVersion);
finally
ms.Free;
end;
LFMType:='unknown';
MissingClasses := nil;
end;
end.

36
ide/checklfmdlg.pas
View File

@ -129,7 +129,8 @@ type
function QuickCheckLFMBuffer({%H-}PascalBuffer, LFMBuffer: TCodeBuffer;
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string;
out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
out MissingClasses: TStrings;// e.g. MyFrame2:TMyFrame
out AmbiguousClasses: TFPList
): TModalResult;
// Now this is just a wrapper for designer/changeclassdialog. Could be moved there.
function RepairLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
@ -152,9 +153,9 @@ type
NewText: string;
end;
function QuickCheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string; out MissingClasses: TStrings): TModalResult;
function QuickCheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer; out LFMType,
LFMComponentName, LFMClassName: string; out LCLVersion: string; out
MissingClasses: TStrings; out AmbiguousClasses: TFPList): TModalResult;
const
ClassFound = 'found';
ClassMissing = 'missing';
@ -196,6 +197,24 @@ var
AFullName:=AClassName;
if Classes[AFullName]<>'' then exit;
// search in registered classes
RegComp:=IDEComponentPalette.FindRegComponent(AFullName);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['QuickCheckLFMBuffer.FindMissingClass AFullName="',AFullName,'" RegComp=',RegComp<>nil]);
{$ENDIF}
if (RegComp<>nil) and (RegComp.GetUnitName<>'')
and not RegComp.ComponentClass.InheritsFrom(TCustomFrame) // not Nested TFrame
then begin
Classes[AFullName]:=ClassFound;
if (AnUnitName='') and RegComp.HasAmbiguousClassName then
begin
if AmbiguousClasses=nil then
AmbiguousClasses:=TFPList.Create;
if AmbiguousClasses.IndexOf(RegComp)<0 then
AmbiguousClasses.Add(RegComp);
end;
exit;
end;
// search in designer base classes
if BaseFormEditor1.FindDesignerBaseClassByName(AFullName,true)<>nil then
begin
@ -212,14 +231,6 @@ var
Classes[AFullName]:=ClassFound;
exit;
end;
// search in registered classes
RegComp:=IDEComponentPalette.FindRegComponent(AFullName);
if (RegComp<>nil) and (RegComp.GetUnitName<>'')
and not RegComp.ComponentClass.InheritsFrom(TCustomFrame) // Nested TFrame
then begin
Classes[AFullName]:=ClassFound;
exit;
end;
// class is missing
DebugLn(['QuickCheckLFMBuffer->FindMissingClass ',ObjNode.Name,':',AFullName,' IsInherited=',ObjNode.IsInherited]);
if MissingClasses=nil then
@ -259,6 +270,7 @@ begin
//DebugLn(['QuickCheckLFMBuffer LFMBuffer=',LFMBuffer.Filename]);
LCLVersion:='';
MissingClasses:=nil;
AmbiguousClasses:=nil;
// read header
ReadLFMHeader(LFMBuffer.Source,LFMType,LFMComponentName,LFMClassName);

11
ide/lfmunitresource.pas
View File

@ -52,7 +52,7 @@ type
class function GetUnitResourceFilename(AUnitFilename: string; {%H-}Loading: boolean): string; override;
class function QuickCheckResourceBuffer(PascalBuffer, LFMBuffer: TObject; out
LFMType, LFMComponentName, LFMClassName: string; out LCLVersion: string;
out MissingClasses: TStrings): TModalResult; override;
out MissingClasses: TStrings; out AmbiguousClasses: TFPList): TModalResult; override;
end;
implementation
@ -144,13 +144,14 @@ begin
end;
end;
class function TLFMUnitResourcefileFormat.QuickCheckResourceBuffer(PascalBuffer,
LFMBuffer: TObject; out LFMType, LFMComponentName, LFMClassName: string; out
LCLVersion: string; out MissingClasses: TStrings): TModalResult;
class function TLFMUnitResourcefileFormat.QuickCheckResourceBuffer(
PascalBuffer, LFMBuffer: TObject; out LFMType, LFMComponentName,
LFMClassName: string; out LCLVersion: string; out MissingClasses: TStrings;
out AmbiguousClasses: TFPList): TModalResult;
begin
Result := QuickCheckLFMBuffer(PascalBuffer as TCodeBuffer,
LFMBuffer as TCodeBuffer, LFMType, LFMComponentName, LFMClassName,
LCLVersion, MissingClasses);
LCLVersion, MissingClasses, AmbiguousClasses);
end;
initialization

265
ide/sourcefilemanager.pas
View File

@ -246,6 +246,11 @@ function LoadLFM(AnUnitInfo: TUnitInfo; OpenFlags: TOpenFlags;
function LoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer;
OpenFlags: TOpenFlags;
CloseFlags: TCloseFlags): TModalResult;
function ResolveAmbiguousLFMClasses(AnUnitInfo: TUnitInfo;
const LFMClassName: string;
AmbiguousClasses: TFPList; // list of TPkgComponent
OpenFlags: TOpenFlags;
out ResolvedClasses, ResolvedVars: TStringToPointerTree): TModalResult;
function OpenComponent(const UnitFilename: string; OpenFlags: TOpenFlags;
CloseFlags: TCloseFlags; out Component: TComponent): TModalResult;
function CloseUnitComponent(AnUnitInfo: TUnitInfo; Flags: TCloseFlags): TModalResult;
@ -5983,14 +5988,19 @@ var
{$IF (FPC_FULLVERSION >= 30003)}
DsgDataModule: TDataModule;
{$ENDIF}
AmbiguousClasses: TFPList;
ResolvedClasses, ResolvedVars: TStringToPointerTree;
begin
{$IFDEF IDE_DEBUG}
debugln('LoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
{$ENDIF}
ReferencesLocked:=false;
MissingClasses:=nil;
NewComponent:=nil;
AmbiguousClasses:=nil;
MissingClasses:=nil;
ResolvedClasses:=nil;
ResolvedVars:=nil;
try
if (ofRevert in OpenFlags) and (AnUnitInfo.Component<>nil) then begin
// the component must be destroyed and recreated => store references
@ -6031,7 +6041,10 @@ begin
// find the classname of the LFM, and check for inherited form
AnUnitInfo.UnitResourceFileformat.QuickCheckResourceBuffer(
AnUnitInfo.Source,LFMBuf,LFMType,LFMComponentName,
NewClassName,LCLVersion,MissingClasses);
NewClassName,LCLVersion,MissingClasses,AmbiguousClasses);
i:=Pos('/',NewClassName);
if i>0 then
System.Delete(NewClassName,1,i); // cut unitname
{$IFDEF VerboseLFMSearch}
debugln('LoadLFM LFM="',LFMBuf.Source,'"');
@ -6094,6 +6107,14 @@ begin
MissingClasses:=nil;
end;
if (AmbiguousClasses<>nil) and (AmbiguousClasses.Count>0) then
begin
if ResolveAmbiguousLFMClasses(AnUnitInfo,NewClassName,AmbiguousClasses,
OpenFlags,ResolvedClasses,ResolvedVars)<>mrOk
then
exit;
end;
BinStream:=nil;
try
// convert text to binary format
@ -6241,7 +6262,10 @@ begin
DebugLn(['LoadLFM Creating designer for hidden component of ',AnUnitInfo.Filename]);
end;
finally
AmbiguousClasses.Free;
MissingClasses.Free;
ResolvedVars.Free;
ResolvedClasses.Free;
if ReferencesLocked then begin
if Project1<>nil then
Project1.UnlockUnitComponentDependencies;
@ -6300,6 +6324,243 @@ begin
Result:=mrOk;
end;
function ResolveAmbiguousLFMClasses(AnUnitInfo: TUnitInfo;
const LFMClassName: string; AmbiguousClasses: TFPList; OpenFlags: TOpenFlags;
out ResolvedClasses, ResolvedVars: TStringToPointerTree): TModalResult;
// Some registered component classes have ambiguous names, e.g. two TButton
// The correct classtype of each variable is defined in the Pascal unit.
// But at designtime, sources can be messy, contain temporary errors
// or codetools can be fooled.
var
Code: TCodeBuffer;
Tool: TCodeTool;
UsesNode, ClassNode, UseUnitNode: TCodeTreeNode;
AnUnitName, InFilename, aFilename, s, VarName, aClassName: String;
Candidates: TFPList;
UnitsLCInUnitPath: TStringToStringTree; // lowercase unitnames to 'found' or 'missing'
UsedUnits: TStringToStringTree; // lowercase unitnames to 'used'
VarNameToType: TStringToStringTree; // 'VarName' to 'ns.unitname/classtype'
i: Integer;
RegComp: TRegisteredComponent;
AVLNode: TAVLTreeNode;
Item: PStringToStringItem;
begin
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses AnUnitInfo="',ExtractFilename(AnUnitInfo.Filename),'" LFMClassName="',LFMClassName,'" AmbiguousClasses.Count=',AmbiguousClasses.Count]);
{$ENDIF}
Code:=AnUnitInfo.Source;
if Code=nil then begin
debugln(['Error: (lazarus) [ResolveAmbiguousLFMClasses] AnUnitInfo.Source=nil of "'+AnUnitInfo.Filename,'"']);
if not (ofQuiet in OpenFlags) then
IDEMessageDialog('Error','[ResolveAmbiguousLFMClasses] AnUnitInfo.Source=nil of "'+AnUnitInfo.Filename+'"',
mtError,[mbOk]);
exit(mrCancel);
end;
ResolvedClasses:=nil;
ResolvedVars:=nil;
CodeToolBoss.Explore(Code,Tool,false,true);
if Tool=nil then begin
debugln(['Error: (lazarus) [ResolveAmbiguousLFMClasses] CodeToolBoss.Explore failed for "',AnUnitInfo.Filename,'"']);
if not (ofQuiet in OpenFlags) then
MainIDE.DoJumpToCompilerMessage(true);
exit(mrCancel);
end;
Candidates:=TFPList.Create;
UnitsLCInUnitPath:=TStringToStringTree.Create(true);
UsedUnits:=TStringToStringTree.Create(true);
VarNameToType:=nil;
try
// quick check, what classes are in the unitpath
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Checking UnitPaths... AmbiguousClasses.Count=',AmbiguousClasses.Count]);
{$ENDIF}
for i:=AmbiguousClasses.Count-1 downto 0 do
begin
Candidates.Clear;
RegComp:=TRegisteredComponent(AmbiguousClasses[i]);
while RegComp.PrevSameName<>nil do
RegComp:=RegComp.PrevSameName;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Search in Unitpath ',i,'/',AmbiguousClasses.Count,' RegComp=',RegComp.GetUnitName+'/'+RegComp.ComponentClass.ClassName]);
{$ENDIF}
while RegComp<>nil do
begin
AnUnitName:=RegComp.GetUnitName;
s:=UnitsLCInUnitPath[lowercase(AnUnitName)];
if s='' then
begin
InFilename:='';
aFilename:=Tool.FindUnitCaseInsensitive(AnUnitName,InFilename);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses RegComp=',RegComp.GetUnitName+'/'+RegComp.ComponentClass.ClassName,' Found in UnitPath="',aFilename,'"']);
{$ENDIF}
if aFilename<>'' then
s:='found'
else
s:='missing';
UnitsLCInUnitPath[lowercase(AnUnitName)]:=s;
end;
if s='found' then
Candidates.Add(RegComp);
RegComp:=RegComp.NextSameName;
end;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Checked UnitPaths ',i,'/',AmbiguousClasses.Count,' Candidates=',Candidates.Count]);
{$ENDIF}
if Candidates.Count=1 then
begin
RegComp:=TRegisteredComponent(Candidates[0]);
if ResolvedClasses=nil then
ResolvedClasses:=TStringToPointerTree.Create(false);
ResolvedClasses[RegComp.ClassName]:=RegComp;
AmbiguousClasses.Delete(i);
end;
end;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Checked UnitPaths AmbiguousClasses=',AmbiguousClasses.Count]);
{$ENDIF}
if AmbiguousClasses.Count=0 then
exit(mrOk);
// quick check, what classes available via the uses clause
// parse the unit ignoring errors, it is enough if codetools can parse til the form class
ClassNode:=Tool.FindClassNodeInUnit(LFMClassName,true,false,true,false);
if ClassNode=nil then
begin
debugln(['Error: (lazarus) [ResolveAmbiguousLFMClasses] class "',LFMClassName,'" not found in "'+AnUnitInfo.Filename,'"']);
if not (ofQuiet in OpenFlags) then
begin
CodeToolBoss.GatherPublishedVarTypes(Code,LFMClassName,VarNameToType);
MainIDE.DoJumpToCompilerMessage(true);
end;
exit(mrCancel);
end;
UsesNode:=Tool.FindMainUsesNode;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses searching UsesClause... UsesNode=',UsesNode<>nil]);
{$ENDIF}
if UsesNode<>nil then
begin
// find all used units
UseUnitNode:=UsesNode.LastChild;
while UseUnitNode<>nil do begin
AnUnitName:=Tool.ExtractUsedUnitName(UseUnitNode,@InFilename);
UseUnitNode:=UseUnitNode.PriorBrother;
if AnUnitName='' then continue;
// due to namespaces, search the unit to find the full unitname
aFilename:=Tool.FindUnitCaseInsensitive(AnUnitName,InFilename);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Uses ',AnUnitName,' File=',ExtractFileNameOnly(aFilename)]);
{$ENDIF}
if aFilename<>'' then
AnUnitName:=ExtractFileNameOnly(aFilename);
UsedUnits[lowercase(AnUnitName)]:='used';
end;
for i:=AmbiguousClasses.Count-1 downto 0 do
begin
Candidates.Clear;
RegComp:=TRegisteredComponent(AmbiguousClasses[i]);
while RegComp.PrevSameName<>nil do
RegComp:=RegComp.PrevSameName;
while RegComp<>nil do
begin
AnUnitName:=RegComp.GetUnitName;
s:=UsedUnits[lowercase(AnUnitName)];
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses ',i,'/',AmbiguousClasses.Count,' RegComp=',AnUnitName+'/'+RegComp.ComponentClass.ClassName,' in Uses="',s,'"']);
{$ENDIF}
if s='used' then
Candidates.Add(RegComp);
RegComp:=RegComp.NextSameName;
end;
if Candidates.Count=1 then
begin
RegComp:=TRegisteredComponent(Candidates[0]);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses only one candidates via uses: ',RegComp.GetUnitName,'/',RegComp.ComponentClass.CLassName]);
{$ENDIF}
if ResolvedClasses=nil then
ResolvedClasses:=TStringToPointerTree.Create(false);
ResolvedClasses[RegComp.ClassName]:=RegComp;
AmbiguousClasses.Delete(i);
end;
end;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Checked Uses AmbiguousClasses=',AmbiguousClasses.Count]);
{$ENDIF}
if AmbiguousClasses.Count=0 then
exit(mrOk);
end;
// finally parse and resolve each variable
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses GatherPublishedVarTypes AmbiguousClasses=',AmbiguousClasses.Count]);
{$ENDIF}
if not CodeToolBoss.GatherPublishedVarTypes(Code,LFMClassName,VarNameToType)
then begin
debugln(['Error: (lazarus) [ResolveAmbiguousLFMClasses] CodeToolBoss.GatherPublishedVarTypes failed']);
if not (ofQuiet in OpenFlags) then
MainIDE.DoJumpToCompilerMessage(true);
exit(mrCancel);
end;
if VarNameToType<>nil then
begin
AVLNode:=VarNameToType.Tree.FindLowest;
while AVLNode<>nil do
begin
Item:=PStringToStringItem(AVLNode.Data);
VarName:=Item^.Name;
aClassName:=Item^.Value; // 'ns.unitname/classname'
RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses VarName="',VarName,'": "',aClassName,'" RegComp=',RegComp<>nil]);
{$ENDIF}
if RegComp=nil then
begin
// this classtype is not registered, e.g. a TFrame or something was renamed
i:=Pos('/',aClassName);
aClassName:=copy(aClassName,i+1,length(aClassName));
RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
if RegComp.HasAmbiguousClassName then
begin
debugln(['Info: (lazarus) [ResolveAmbiguousLFMClasses] class=',Item^.Value,' is not registered and there are ambiguous classes']);
// this will be handled by the IDE streaming
RegComp:=nil;
end;
end;
if RegComp<>nil then
begin
if ResolvedVars=nil then
ResolvedVars:=TStringToPointerTree.Create(false);
ResolvedVars[VarName]:=RegComp;
end;
AVLNode:=VarNameToType.Tree.FindSuccessor(AVLNode);
end;
end;
AmbiguousClasses.Clear;
finally
VarNameToType.Free;
UsedUnits.Free;
UnitsLCInUnitPath.Free;
Candidates.Free;
end;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses END']);
{$ENDIF}
Result:=mrOK;
end;
function OpenComponent(const UnitFilename: string;
OpenFlags: TOpenFlags; CloseFlags: TCloseFlags; out Component: TComponent): TModalResult;
var