From 345f47ca6f332352b84abc56ecf13240cd358127 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 13 Apr 2023 15:38:05 +0200 Subject: [PATCH] IDE: loadlfm: resolve ambigious registered component classes --- components/codetools/stdcodetools.pas | 47 ++++++----- components/ideintf/componentreg.pas | 4 +- components/lazutils/avglvltree.pas | 31 +++++++ designer/jitforms.pp | 38 ++++++--- ide/customformeditor.pp | 111 ++++++++++++++++++-------- ide/project.pp | 12 ++- ide/sourcefilemanager.pas | 71 ++++++++++------ 7 files changed, 225 insertions(+), 89 deletions(-) diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index d183366042..60a5b45fd5 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -4606,31 +4606,38 @@ begin //debugln(['TStandardCodeTool.GatherPublishedVarTypes WARNING not a simple type: ',VarName]); continue; // e.g. specialize A 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); diff --git a/components/ideintf/componentreg.pas b/components/ideintf/componentreg.pas index ba9f5cae5f..a41d116f40 100644 --- a/components/ideintf/componentreg.pas +++ b/components/ideintf/componentreg.pas @@ -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; diff --git a/components/lazutils/avglvltree.pas b/components/lazutils/avglvltree.pas index 7762d0f971..7c53b6d38f 100644 --- a/components/lazutils/avglvltree.pas +++ b/components/lazutils/avglvltree.pas @@ -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; diff --git a/designer/jitforms.pp b/designer/jitforms.pp index 764eb48959..30a0b1a5f1 100644 --- a/designer/jitforms.pp +++ b/designer/jitforms.pp @@ -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; //============================================================================== diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index 81201a2475..e27dc65aaa 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -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; diff --git a/ide/project.pp b/ide/project.pp index 03c1093e43..f25f9cdb4e 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -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; diff --git a/ide/sourcefilemanager.pas b/ide/sourcefilemanager.pas index d99f7b6255..c1402ac9e1 100644 --- a/ide/sourcefilemanager.pas +++ b/ide/sourcefilemanager.pas @@ -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;