diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 94317660fc..4073be7269 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -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; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index f50bdce508..d183366042 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -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 diff --git a/components/ideintf/unitresources.pas b/components/ideintf/unitresources.pas index 5440fb3e5c..e52a3d6b25 100644 --- a/components/ideintf/unitresources.pas +++ b/components/ideintf/unitresources.pas @@ -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; diff --git a/examples/xmlresource/xmlresourcefile.pas b/examples/xmlresource/xmlresourcefile.pas index 483155fe34..02c733d6db 100644 --- a/examples/xmlresource/xmlresourcefile.pas +++ b/examples/xmlresource/xmlresourcefile.pas @@ -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. diff --git a/ide/checklfmdlg.pas b/ide/checklfmdlg.pas index bf8eb738b9..02ab445f4a 100644 --- a/ide/checklfmdlg.pas +++ b/ide/checklfmdlg.pas @@ -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); diff --git a/ide/lfmunitresource.pas b/ide/lfmunitresource.pas index 1e50f7ea1f..e497d16406 100644 --- a/ide/lfmunitresource.pas +++ b/ide/lfmunitresource.pas @@ -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 diff --git a/ide/sourcefilemanager.pas b/ide/sourcefilemanager.pas index 333c00afd9..d99f7b6255 100644 --- a/ide/sourcefilemanager.pas +++ b/ide/sourcefilemanager.pas @@ -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