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

IDE: loadlfm: resolve ambigious registered component classes

Browse Source
This commit is contained in:
mattias 2023-04-13 15:38:05 +02:00
parent 16eea4aacd
commit 345f47ca6f
7 changed files with 225 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
components/codetools/stdcodetools.pas
View File

@ -4606,31 +4606,38 @@ begin
//debugln(['TStandardCodeTool.GatherPublishedVarTypes WARNING not a simple type: ',VarName]);
continue; // e.g. specialize A<B>
end;
if (Pos('.',VarType)<1) then begin
// simple type without unitname
NewType:=SimpleTypes[VarType];
if NewType='' then
begin
// resolve simple type
Params:=TFindDeclarationParams.Create;
try
Params.ContextNode:=TypeNode;
// resolve alias
aContext:=FindBaseTypeOfNode(Params,TypeNode);
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Type "',VarType,'" found at ',FindContextToString(aContext,false)]);
if aContext.Node.Desc=ctnClass then
VarType:=aContext.Tool.ExtractClassName(aContext.Node,false);
NewType:=SimpleTypes[VarType];
if NewType='' then
begin
// resolve simple type
Params:=TFindDeclarationParams.Create;
try
Params.ContextNode:=TypeNode;
// resolve alias
aContext:=FindBaseTypeOfNode(Params,TypeNode);
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Type "',VarType,'" found at ',FindContextToString(aContext,false)]);
if aContext.Node.Desc in AllClasses then
NewType:=aContext.Tool.ExtractClassName(aContext.Node,false)
else if aContext.Node.Desc in AllPascalTypes then
NewType:=aContext.Tool.ExtractDefinitionName(aContext.Node)
else
NewType:='';
if IsValidIdent(NewType,true,true) then
begin
CurUnitName:=aContext.Tool.GetSourceName(false);
// unitname/vartype
NewType:=CurUnitName+'/'+VarType;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Resolved: "',VarType,'" = "',NewType,'"']);
SimpleTypes[VarType]:=NewType;
finally
Params.Free;
NewType:=CurUnitName+'/'+NewType;
end else begin
NewType:='';
end;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Resolved: "',VarType,'" = "',NewType,'"']);
SimpleTypes[VarType]:=NewType;
finally
Params.Free;
end;
VarType:=NewType;
end;
VarType:=NewType;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Added ',VarName,':',VarType]);
if VarNameToType=nil then
VarNameToType:=TStringToStringTree.Create(false);

4
components/ideintf/componentreg.pas
View File

@ -1153,7 +1153,6 @@ function TBaseComponentPalette.FindRegComponent(const ACompClassName: string): T
var
i: Integer;
HasUnitName: Boolean;
aComp: TRegisteredComponent;
CurClassName: String;
begin
// A small optimization. If same type is asked many times, return it quickly.
@ -1170,6 +1169,9 @@ begin
CurClassName:=Result.ComponentClass.ClassName;
if SameText(CurClassName, ACompClassName) then
begin
if not HasUnitName then
while Result.PrevSameName<>nil do
Result:=Result.PrevSameName;
fLastFoundCompClassName := ACompClassName;
fLastFoundRegComp := Result;
exit;

31
components/lazutils/avglvltree.pas
View File

@ -279,6 +279,8 @@ type
function ItemsAreEqual(p1, p2: PStringMapItem): boolean; override;
function CreateCopy(Src: PStringMapItem): PStringMapItem; override;
public
procedure Assign(Source: TCustomStringMap); override;
procedure AddTree(Source: TStringToPointerTree); overload;
function GetData(const Name: string; out Value: Pointer): boolean;
function GetNodeData(Node: TAVLTreeNode): PStringToPointerTreeItem; inline;
function GetEnumerator: TStringToPointerTreeEnumerator;
@ -511,6 +513,35 @@ begin
Result:=PStringMapItem(NewItem);
end;
procedure TStringToPointerTree.Assign(Source: TCustomStringMap);
var
Node: TAvlTreeNode;
Item: PStringToPointerTreeItem;
begin
if (Source=nil) or (Source.ClassType<>ClassType) then
raise Exception.Create('invalid class');
Clear;
Node:=Source.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringToPointerTreeItem(Node.Data);
Values[Item^.Name]:=Item^.Value;
Node:=Node.Successor;
end;
end;
procedure TStringToPointerTree.AddTree(Source: TStringToPointerTree);
var
Node: TAVLTreeNode;
Item: PStringToPointerTreeItem;
begin
Node:=Source.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringToPointerTreeItem(Node.Data);
Values[Item^.Name]:=Item^.Value;
Node:=Node.Successor;
end;
end;
function TStringToPointerTree.GetData(const Name: string; out Value: Pointer): boolean;
var
Node: TAvlTreeNode;

38
designer/jitforms.pp
View File

@ -84,7 +84,7 @@ type
var BinStreams: TFPList;// list of TExtMemoryStream;
var Abort: boolean) of object;
TJITFindClass = procedure(Sender: TObject;
const ComponentClassName: string;
const VarName, aClassUnitName, aClassName: string;
var ComponentClass: TComponentClass) of object;
@ -98,7 +98,9 @@ type
TJITComponentList = class(TComponent)
private
FContextObject: TObject;
FCurUnknownClass: string;
FCurUnknownVarName: string;
FCurUnknownClassName: string;
FCurUnknownClassUnitName: string;
FCurUnknownProperty: string;
FErrors: TLRPositionLinks;
FOnBeforeCreate: TJITBeforeCreateEvent;
@ -150,6 +152,8 @@ type
var Handled: Boolean);
procedure ReaderFindComponentClass({%H-}Reader: TReader;
const FindClassName: Ansistring; var ComponentClass: TComponentClass);
procedure ReaderFindComponentClassEx(Reader: TReader; const aName,
anUnitname, aClassName: AnsiString; var ComponentClass: TComponentClass);
procedure ReaderCreateComponent(Reader: TReader;
ComponentClass: TComponentClass; var Component: TComponent);
procedure ReaderReadComponent(Component: TComponent);
@ -224,7 +228,9 @@ type
property CurReadChildClass: TComponentClass read FCurReadChildClass;
property CurReadErrorMsg: string read FCurReadErrorMsg;
property CurUnknownProperty: string read FCurUnknownProperty;
property CurUnknownClass: string read FCurUnknownClass;
property CurUnknownVarName: string read FCurUnknownVarName;
property CurUnknownClassName: string read FCurUnknownClassName;
property CurUnknownClassUnitName: string read FCurUnknownClassUnitName;
property ContextObject: TObject read FContextObject;
property Errors: TLRPositionLinks read FErrors;
end;
@ -1026,6 +1032,9 @@ begin
Reader.OnAncestorNotFound:=@ReaderAncestorNotFound;
Reader.OnCreateComponent:=@ReaderCreateComponent;
Reader.OnFindComponentClass:=@ReaderFindComponentClass;
{$IFDEF FPC_FULLVERSION>30300}
Reader.OnFindComponentClassEx:=@ReaderFindComponentClassEx;
{$ENDIF}
{$IFDEF VerboseJITForms}
debugln('[TJITComponentList.InitReading] B');
@ -1948,20 +1957,31 @@ end;
procedure TJITComponentList.ReaderFindComponentClass(Reader: TReader;
const FindClassName: Ansistring; var ComponentClass: TComponentClass);
begin
ReaderFindComponentClassEx(Reader,'','',FindClassName,ComponentClass);
end;
procedure TJITComponentList.ReaderFindComponentClassEx(Reader: TReader;
const aName, anUnitname, aClassName: AnsiString;
var ComponentClass: TComponentClass);
begin
if Reader=nil then ;
fCurReadChild:=nil;
fCurReadChildClass:=ComponentClass;
FCurUnknownClass:=FindClassName;
FCurUnknownVarName:=aName;
FCurUnknownClassUnitName:=anUnitname;
FCurUnknownClassName:=aClassName;
if ComponentClass=nil then begin
if Assigned(OnFindClass) then
OnFindClass(Self,FindClassName,ComponentClass);
OnFindClass(Self,FCurUnknownVarName,FCurUnknownClassUnitName,FCurUnknownClassName,ComponentClass);
fCurReadChildClass:=ComponentClass;
if ComponentClass=nil then begin
DebugLn('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
+''' is unregistered');
DebugLn('Error: (lazarus) [TJITComponentList.ReaderFindComponentClassEx] VarName="',FCurUnknownVarName,'" Unit="',FCurUnknownClassUnitName,'" Class="',FCurUnknownClassName,'" is not registered');
// The reader will create a ReaderError automatically
end;
end;
FCurUnknownClass:='';
FCurUnknownVarName:='';
FCurUnknownClassUnitName:='';
FCurUnknownClassName:='';
end;
procedure TJITComponentList.ReaderCreateComponent(Reader: TReader;
@ -1978,7 +1998,7 @@ procedure TJITComponentList.ReaderReadComponent(Component: TComponent);
begin
fCurReadChild:=Component;
fCurReadChildClass:=TComponentClass(Component.ClassType);
DebugLn('TJITComponentList.ReaderReadComponent A ',Component.Name,':',Component.ClassName);
DebugLn('Info: (lazarus) TJITComponentList.ReaderReadComponent ',Component.Name,':',Component.UnitName,'/',Component.ClassName);
end;
//==============================================================================

111
ide/customformeditor.pp
View File

@ -45,7 +45,7 @@ uses
Forms, Menus, Dialogs,
// LazUtils
FileUtil, LazFileUtils, LazFileCache, CompWriterPas, LazLoggerBase, LazTracer,
LazUTF8,
LazUTF8, AvgLvlTree,
// Codetools
CodeCache, CodeTree, CodeToolManager, FindDeclarationTool,
// IDEIntf
@ -111,8 +111,8 @@ type
var BinStreams: TFPList;// list of TExtMemoryStream;
var Abort: boolean);
procedure JITListFindClass(Sender: TObject;
const ComponentClassName: string;
var ComponentClass: TComponentClass);
const VarName, ComponentUnitName, ComponentClassName: string;
var ComponentClass: TComponentClass);
function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; override;
@ -2189,7 +2189,7 @@ begin
jfeUnknownComponentClass:
begin
aMsg:=Format(lisCFEClassNotFound,
[aMsg, LineEnding, JITComponentList.CurUnknownClass]);
[aMsg, LineEnding, JITComponentList.CurUnknownClassName]);
end;
end;
if Buttons=[mbIgnore,mbCancel] then begin
@ -2351,43 +2351,87 @@ begin
end;
end;
procedure TCustomFormEditor.JITListFindClass(Sender: TObject;
const ComponentClassName: string; var ComponentClass: TComponentClass);
procedure TCustomFormEditor.JITListFindClass(Sender: TObject; const VarName,
ComponentUnitName, ComponentClassName: string;
var ComponentClass: TComponentClass);
function FindRegisteredComp(const aClassName: string): TRegisteredComponent;
begin
Result:=IDEComponentPalette.FindRegComponent(aClassName);
if Result=nil then exit;
if Result.ComponentClass.InheritsFrom(TCustomFrame) then
begin
debugln(['TCustomFormEditor.JITListFindClass.FindRegisteredComp "',aClassName,'", ignoring registered TFrame descendant "',dbgsname(Result.ComponentClass),'"']);
exit(nil); // Nested TFrame
end;
end;
var
AnUnitInfo: TUnitInfo;
Component: TComponent;
RegComp: TRegisteredComponent;
JITList: TJITComponentList;
i: Integer;
begin
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]);
RegComp:=IDEComponentPalette.FindRegComponent(ComponentClassName);
if (RegComp<>nil) and
not RegComp.ComponentClass.InheritsFrom(TCustomFrame) then // Nested TFrame
//DebugLn(['TCustomFormEditor.JITListFindClass Var="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'"']);
JITList:=Sender as TJITComponentList;
//DebugLn(['TCustomFormEditor.JITListFindClass JITList.ContextObject=',DbgSName(JITList.ContextObject)]);
if JITList.ContextObject is TUnitInfo then begin
AnUnitInfo:=TUnitInfo(JITList.ContextObject);
{$IFDEF VerboseIDEAmbiguousClasses}
if AnUnitInfo.ComponentVarsToClasses<>nil then
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentVarsToClasses.Count=',AnUnitInfo.ComponentVarsToClasses.Count])
else
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentVarsToClasses=nil']);
{$ENDIF}
if (AnUnitInfo.ComponentVarsToClasses<>nil) and (VarName<>'') then
begin
ComponentClass:=TComponentClass(AnUnitInfo.ComponentVarsToClasses[VarName]);
if ComponentClass<>nil then
begin
// use a specific class for this variable
debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" ComponentClass from UnitInfo-Vars=',ComponentClass.UnitName,'/',ComponentClass.ClassName]);
exit;
end;
end;
{$IFDEF VerboseIDEAmbiguousClasses}
if AnUnitInfo.ComponentTypesToClasses<>nil then
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentTypesToClasses.Count=',AnUnitInfo.ComponentTypesToClasses.Count])
else
debugln(['TCustomFormEditor.JITListFindClass AnUnitInfo.ComponentTypesToClasses=nil']);
{$ENDIF}
if AnUnitInfo.ComponentTypesToClasses<>nil then
begin
ComponentClass:=TComponentClass(AnUnitInfo.ComponentTypesToClasses[ComponentClassName]);
if ComponentClass<>nil then
begin
// use a specific class for this classname
debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" ComponentClass from UnitInfo-Classes=',ComponentClass.UnitName,'/',ComponentClass.ClassName]);
exit;
end;
end;
end;
// search in the registered components
RegComp:=nil;
if ComponentUnitName<>'' then
RegComp:=FindRegisteredComp(ComponentUnitName+'/'+ComponentClassName);
if RegComp=nil then
begin
// search without unitname in the registered components
RegComp:=FindRegisteredComp(ComponentClassName);
if (RegComp<>nil) and RegComp.HasAmbiguousClassName then
begin
debugln(['TCustomFormEditor.JITListFindClass VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'". Found ambigious registered ComponentClass=',dbgsname(RegComp.ComponentClass)]);
// ToDo: ask user
end;
end;
if (RegComp<>nil) then
begin
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
ComponentClass:=RegComp.ComponentClass;
end else begin
JITList:=Sender as TJITComponentList;
//DebugLn(['TCustomFormEditor.JITListFindClass JITList.ContextObject=',DbgSName(JITList.ContextObject)]);
if JITList.ContextObject is TUnitInfo then begin
AnUnitInfo:=TUnitInfo(JITList.ContextObject);
if AnUnitInfo.ComponentFallbackClasses<>nil then
for i:=0 to AnUnitInfo.ComponentFallbackClasses.Count-1 do begin
if CompareText(AnUnitInfo.ComponentFallbackClasses[i],ComponentClassName)=0
then begin
{$IFDEF EnableNestedComponentsWithoutLFM}
ComponentClass:=TComponentClass(Pointer(AnUnitInfo.ComponentFallbackClasses.Objects[i]));
if ComponentClass<>nil then begin
// ToDo: create or share a jitclass
debugln(['TCustomFormEditor.JITListFindClass searched "',ComponentClassName,'", found fallback class "',DbgSName(ComponentClass),'" of unitinfo ',AnUnitInfo.Filename]);
exit;
end;
{$ENDIF}
end;
end;
end;
// search in open and hidden designer forms (e.g. nested frames)
AnUnitInfo:=Project1.FirstUnitWithComponent;
while AnUnitInfo<>nil do begin
Component:=AnUnitInfo.Component;
@ -2400,7 +2444,10 @@ begin
AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
end;
end;
//DebugLn(['TCustomFormEditor.JITListFindClass Searched=',ComponentClassName,' Found=',DbgSName(ComponentClass)]);
//if ComponentClass=nil then
// DebugLn(['TCustomFormEditor.JITListFindClass Searched VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" Not Found'])
//else
// DebugLn(['TCustomFormEditor.JITListFindClass Searched VarName="',VarName,'" "',ComponentUnitName,'/',ComponentClassName,'" Found ',ComponentClass.UnitName,'/',ComponentClass.ClassName])
end;
function TCustomFormEditor.GetDesignerBaseClasses(Index: integer): TComponentClass;

12
ide/project.pp
View File

@ -256,7 +256,8 @@ type
TUnitInfo = class(TLazProjectFile)
private
FComponentFallbackClasses: TStrings;
FComponentTypesToClasses: TStringToPointerTree;
FComponentVarsToClasses: TStringToPointerTree;
FCustomDefaultHighlighter: boolean;
FDefaultSyntaxHighlighter: TLazSyntaxHighlighter;
FDisableI18NForLFM: boolean;
@ -443,8 +444,10 @@ type
property ComponentName: string read fComponentName write fComponentName;
property ComponentResourceName: string read fComponentResourceName
write fComponentResourceName;
property ComponentFallbackClasses: TStrings read FComponentFallbackClasses
write FComponentFallbackClasses; // classname to componentclass, for not registered classes in lfm
property ComponentTypesToClasses: TStringToPointerTree read FComponentTypesToClasses
write FComponentTypesToClasses; // classname to TComponentClass, for not registered and ambiguous classes in lfm
property ComponentVarsToClasses: TStringToPointerTree read FComponentVarsToClasses
write FComponentVarsToClasses; // variablename to TComponentClass, for ambiguous classes in lfm
property ComponentState: TWindowState read FComponentState write FComponentState;
property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass
write FResourceBaseClass;
@ -1609,7 +1612,8 @@ begin
FreeAndNil(FBookmarks);
Project:=nil;
FreeAndNil(FEditorInfoList);
FreeAndNil(FComponentFallbackClasses);
FreeAndNil(FComponentTypesToClasses);
FreeAndNil(FComponentVarsToClasses);
inherited Destroy;
end;

71
ide/sourcefilemanager.pas
View File

@ -250,7 +250,9 @@ function ResolveAmbiguousLFMClasses(AnUnitInfo: TUnitInfo;
const LFMClassName: string;
AmbiguousClasses: TFPList; // list of TPkgComponent
OpenFlags: TOpenFlags;
out ResolvedClasses, ResolvedVars: TStringToPointerTree): TModalResult;
out ResolvedClasses: TStringToPointerTree; // ClassName to TComponentClass
out ResolvedVars: TStringToPointerTree // VarName to TComponentClass
): TModalResult;
function OpenComponent(const UnitFilename: string; OpenFlags: TOpenFlags;
CloseFlags: TCloseFlags; out Component: TComponent): TModalResult;
function CloseUnitComponent(AnUnitInfo: TUnitInfo; Flags: TCloseFlags): TModalResult;
@ -5983,7 +5985,7 @@ var
PreventAutoSize: Boolean;
NewControl: TControl;
ARestoreVisible: Boolean;
AncestorClass: TComponentClass;
NestedAncestorClass: TComponentClass;
DsgControl: TCustomDesignControl;
{$IF (FPC_FULLVERSION >= 30003)}
DsgDataModule: TDataModule;
@ -6052,6 +6054,11 @@ begin
if AnUnitInfo.Component=nil then begin
// load/create new instance
if AnUnitInfo.ComponentTypesToClasses<>nil then
AnUnitInfo.ComponentTypesToClasses.Clear;
if AnUnitInfo.ComponentVarsToClasses<>nil then
AnUnitInfo.ComponentVarsToClasses.Clear;
if (NewClassName='') or (LFMType='') then begin
DebugLn(['LoadLFM LFM file corrupt']);
Result:=IDEMessageDialog(lisLFMFileCorrupt,
@ -6072,6 +6079,8 @@ begin
{$IFDEF VerboseLFMSearch}
DebugLn(['LoadLFM has nested: ',AnUnitInfo.Filename]);
{$ENDIF}
if AnUnitInfo.ComponentTypesToClasses=nil then
AnUnitInfo.ComponentTypesToClasses:=TStringToPointerTree.Create(false);
for i:=MissingClasses.Count-1 downto 0 do begin
NestedClassName:=MissingClasses[i];
{$IFDEF VerboseLFMSearch}
@ -6087,24 +6096,18 @@ begin
Result:=LoadComponentDependencyHidden(AnUnitInfo,NestedClassName,
OpenFlags,
{$IFDEF EnableNestedComponentsWithoutLFM}false,{$ELSE}true,{$ENDIF}
NestedClass,NestedUnitInfo,AncestorClass);
NestedClass,NestedUnitInfo,NestedAncestorClass);
if Result<>mrOk then begin
DebugLn(['LoadLFM DoLoadComponentDependencyHidden NestedClassName=',NestedClassName,' failed for ',AnUnitInfo.Filename]);
exit;
end;
if NestedClass<>nil then
MissingClasses.Objects[i]:=TObject(Pointer(NestedClass))
else if AncestorClass<>nil then
MissingClasses.Objects[i]:=TObject(Pointer(AncestorClass));
AnUnitInfo.ComponentTypesToClasses[NestedClassName]:=NestedClass
else if NestedAncestorClass<>nil then
AnUnitInfo.ComponentTypesToClasses[NestedClassName]:=NestedAncestorClass;
end;
end;
//DebugLn(['LoadLFM had nested: ',AnUnitInfo.Filename]);
if AnUnitInfo.ComponentFallbackClasses<>nil then begin
AnUnitInfo.ComponentFallbackClasses.Free;
AnUnitInfo.ComponentFallbackClasses:=nil;
end;
AnUnitInfo.ComponentFallbackClasses:=MissingClasses;
MissingClasses:=nil;
end;
if (AmbiguousClasses<>nil) and (AmbiguousClasses.Count>0) then
@ -6113,6 +6116,18 @@ begin
OpenFlags,ResolvedClasses,ResolvedVars)<>mrOk
then
exit;
if ResolvedClasses<>nil then
begin
if AnUnitInfo.ComponentTypesToClasses=nil then
AnUnitInfo.ComponentTypesToClasses:=TStringToPointerTree.Create(false);
AnUnitInfo.ComponentTypesToClasses.AddTree(ResolvedClasses);
end;
if ResolvedVars<>nil then
begin
if AnUnitInfo.ComponentVarsToClasses=nil then
AnUnitInfo.ComponentVarsToClasses:=TStringToPointerTree.Create(false);
AnUnitInfo.ComponentVarsToClasses.AddTree(ResolvedVars);
end;
end;
BinStream:=nil;
@ -6266,6 +6281,14 @@ begin
MissingClasses.Free;
ResolvedVars.Free;
ResolvedClasses.Free;
if AnUnitInfo.ComponentTypesToClasses<>nil then begin
AnUnitInfo.ComponentTypesToClasses.Free;
AnUnitInfo.ComponentTypesToClasses:=nil;
end;
if AnUnitInfo.ComponentVarsToClasses<>nil then begin
AnUnitInfo.ComponentVarsToClasses.Free;
AnUnitInfo.ComponentVarsToClasses:=nil;
end;
if ReferencesLocked then begin
if Project1<>nil then
Project1.UnlockUnitComponentDependencies;
@ -6326,7 +6349,8 @@ end;
function ResolveAmbiguousLFMClasses(AnUnitInfo: TUnitInfo;
const LFMClassName: string; AmbiguousClasses: TFPList; OpenFlags: TOpenFlags;
out ResolvedClasses, ResolvedVars: TStringToPointerTree): TModalResult;
out ResolvedClasses: TStringToPointerTree; out
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
@ -6374,7 +6398,7 @@ begin
try
// quick check, what classes are in the unitpath
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Checking UnitPaths... AmbiguousClasses.Count=',AmbiguousClasses.Count]);
debugln(['ResolveAmbiguousLFMClasses Checking UnitPaths... AmbiguousClasses=',AmbiguousClasses.Count]);
{$ENDIF}
for i:=AmbiguousClasses.Count-1 downto 0 do
begin
@ -6383,7 +6407,7 @@ begin
while RegComp.PrevSameName<>nil do
RegComp:=RegComp.PrevSameName;
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Search in Unitpath ',i,'/',AmbiguousClasses.Count,' RegComp=',RegComp.GetUnitName+'/'+RegComp.ComponentClass.ClassName]);
debugln(['ResolveAmbiguousLFMClasses Checking Unitpath: ',i,'/',AmbiguousClasses.Count,' RegComp=',RegComp.GetUnitName+'/'+RegComp.ComponentClass.ClassName]);
{$ENDIF}
while RegComp<>nil do
begin
@ -6408,15 +6432,15 @@ begin
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]);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses Resolved by UnitPaths ',i,'/',AmbiguousClasses.Count,' RegComp=',RegComp.GetUnitName+'/'+RegComp.ComponentClass.ClassName]);
{$ENDIF}
if ResolvedClasses=nil then
ResolvedClasses:=TStringToPointerTree.Create(false);
ResolvedClasses[RegComp.ClassName]:=RegComp;
ResolvedClasses[RegComp.ComponentClass.ClassName]:=RegComp.ComponentClass;
AmbiguousClasses.Delete(i);
end;
end;
@ -6484,11 +6508,11 @@ begin
begin
RegComp:=TRegisteredComponent(Candidates[0]);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses only one candidates via uses: ',RegComp.GetUnitName,'/',RegComp.ComponentClass.CLassName]);
debugln(['ResolveAmbiguousLFMClasses Resolved via Uses: ',RegComp.GetUnitName,'/',RegComp.ComponentClass.ClassName]);
{$ENDIF}
if ResolvedClasses=nil then
ResolvedClasses:=TStringToPointerTree.Create(false);
ResolvedClasses[RegComp.ClassName]:=RegComp;
ResolvedClasses[RegComp.ComponentClass.ClassName]:=RegComp.ComponentClass;
AmbiguousClasses.Delete(i);
end;
end;
@ -6521,7 +6545,8 @@ begin
aClassName:=Item^.Value; // 'ns.unitname/classname'
RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
{$IFDEF VerboseIDEAmbiguousClasses}
debugln(['ResolveAmbiguousLFMClasses VarName="',VarName,'": "',aClassName,'" RegComp=',RegComp<>nil]);
if RegComp<>nil then
debugln(['ResolveAmbiguousLFMClasses VarName="',VarName,'": "',aClassName,'" Found RegComp=',RegComp.ComponentClass.UnitName,'/',RegComp.ComponentClass.ClassName]);
{$ENDIF}
if RegComp=nil then
begin
@ -6540,7 +6565,7 @@ begin
begin
if ResolvedVars=nil then
ResolvedVars:=TStringToPointerTree.Create(false);
ResolvedVars[VarName]:=RegComp;
ResolvedVars[VarName]:=RegComp.ComponentClass;
end;
AVLNode:=VarNameToType.Tree.FindSuccessor(AVLNode);
end;