diff --git a/designer/jitforms.pp b/designer/jitforms.pp index ea9e6a8d87..e9dce58e96 100644 --- a/designer/jitforms.pp +++ b/designer/jitforms.pp @@ -808,11 +808,10 @@ end; function TJITComponentList.OnFindGlobalComponent( const AName: AnsiString): TComponent; begin - // Paul: Do we need search by application? - Result := Application.FindComponent(AName); - if Result = nil then - Result := PkgBoss.FindReferencedRootComponent(CurReadJITComponent, AName); - // DebugLn(dbgsName(CurReadJITComponent), ' FIND global component ', AName, ' ', dbgsName(Result)); + // Note: do not search in the 'Application' object + // this function should only find designer forms + Result := PkgBoss.FindReferencedRootComponent(CurReadJITComponent, AName); + //DebugLn(dbgsName(CurReadJITComponent), ' FIND global component ', AName, ' ', dbgsName(Result)); end; procedure TJITComponentList.InitReading(BinStream: TStream; diff --git a/ide/main.pp b/ide/main.pp index 673c2fa711..b1a8f3de8b 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -613,7 +613,8 @@ type function DoLoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer; OpenFlags: TOpenFlags; CloseFlags: TCloseFlags): TModalResult; - function DoFixupComponentReferences(AnUnitInfo: TUnitInfo): TModalResult; + function DoFixupComponentReferences(AnUnitInfo: TUnitInfo; + OpenFlags: TOpenFlags): TModalResult; function DoLoadComponentDependencyHidden(AnUnitInfo: TUnitInfo; const AComponentClassName: string; Flags: TOpenFlags; var AComponentClass: TComponentClass; @@ -5458,7 +5459,7 @@ begin AnUnitInfo.AddRequiresComponentDependency(AncestorUnitInfo); if NewComponent<>nil then begin // component loaded, now load the referenced units - Result:=DoFixupComponentReferences(AnUnitInfo); + Result:=DoFixupComponentReferences(AnUnitInfo,OpenFlags); if Result<>mrOk then exit; end else begin // error streaming component -> examine lfm file @@ -5519,8 +5520,111 @@ begin Result:=mrOk; end; -function TMainIDE.DoFixupComponentReferences(AnUnitInfo: TUnitInfo - ): TModalResult; +function TMainIDE.DoFixupComponentReferences(AnUnitInfo: TUnitInfo; + OpenFlags: TOpenFlags): TModalResult; + +var + UsedUnitFilenames: TStrings; + ComponentNameToUnitFilename: TStringList; + + function FindUnitFilename(const aComponentName: string): string; + var + RefUnitInfo: TUnitInfo; + i: Integer; + UnitFilename: string; + LFMFilename: String; + LFMCode: TCodeBuffer; + LFMType: String; + LFMComponentName: String; + LFMClassName: String; + ModalResult: TModalResult; + CTResult: Boolean; + begin + // search in the project + RefUnitInfo:=Project1.UnitWithComponentName(aComponentName); + if RefUnitInfo<>nil then begin + Result:=RefUnitInfo.Filename; + exit; + end; + + // search in the used units of the .lpr files + if (Project1.MainUnitInfo<>nil) + and (Project1.MainUnitInfo.Source<>nil) + and (pfMainUnitIsPascalSource in Project1.Flags) then begin + if (UsedUnitFilenames=nil) then begin + // parse once all available component names in all .lfm files + ComponentNameToUnitFilename:=TStringList.Create; + CTResult:=CodeToolBoss.FindUsedUnitFiles(Project1.MainUnitInfo.Source, + UsedUnitFilenames); + if UsedUnitFilenames=nil then + UsedUnitFilenames:=TStringList.Create; + if not CTResult then begin + DebugLn(['TMainIDE.DoFixupComponentReferences.FindLFMFilename failed parsing ',Project1.MainUnitInfo.Filename]); + // ignore the error. This was just a fallback search. + end; + for i:=0 to UsedUnitFilenames.Count-1 do begin + UnitFilename:=UsedUnitFilenames[i]; + LFMFilename:=ChangeFileExt(UnitFilename,'.lfm'); + if FileExistsCached(LFMFilename) then begin + // load the lfm file + ModalResult:=LoadCodeBuffer(LFMCode,LFMFilename,[lbfCheckIfText]); + if ModalResult<>mrOk then begin + debugln('TMainIDE.DoFixupComponentReferences Failed loading ',LFMFilename); + end else begin + // read the LFM component name + ReadLFMHeader(LFMCode.Source,LFMType,LFMComponentName,LFMClassName); + if LFMComponentName<>'' then + ComponentNameToUnitFilename.Values[LFMComponentName]:=UnitFilename; + end; + end; + end; + end; + UnitFilename:=ComponentNameToUnitFilename.Values[aComponentName]; + if UnitFilename<>'' then begin + Result:=UnitFilename; + exit; + end; + end; + + Result:=''; + end; + + function LoadDependencyHidden(const RefRootName: string): TModalResult; + var + LFMFilename: String; + LFMCode: TCodeBuffer; + ModalResult: TModalResult; + UnitFilename: String; + RefUnitInfo: TUnitInfo; + begin + Result:=mrCancel; + + // load lfm + UnitFilename:=FindUnitFilename(RefRootName); + if UnitFilename='' then begin + DebugLn(['TMainIDE.DoFixupComponentReferences.LoadDependencyHidden failed to find lfm for "',RefRootName,'"']); + exit(mrCancel); + end; + LFMFilename:=ChangeFileExt(UnitFilename,'.lfm'); + ModalResult:=LoadCodeBuffer(LFMCode,LFMFilename,[lbfCheckIfText]); + if ModalResult<>mrOk then begin + debugln('TMainIDE.DoFixupComponentReferences Failed loading ',LFMFilename); + exit(mrCancel); + end; + + RefUnitInfo:=Project1.UnitInfoWithFilename(UnitFilename); + // create unit info + if RefUnitInfo=nil then begin + RefUnitInfo:=TUnitInfo.Create(nil); + RefUnitInfo.Filename:=UnitFilename; + Project1.AddFile(RefUnitInfo,false); + end; + + // load resource hidden + Result:=DoLoadLFM(RefUnitInfo,LFMCode, + OpenFlags+[ofLoadHiddenResource],[]); + end; + var CurRoot: TComponent; ReferenceRootNames: TStringList; @@ -5530,25 +5634,43 @@ var begin CurRoot:=AnUnitInfo.Component; if CurRoot=nil then exit(mrOk); + UsedUnitFilenames:=nil; + ComponentNameToUnitFilename:=nil; ReferenceRootNames:=TStringList.Create; ReferenceInstanceNames:=TStringList.Create; try GetFixupReferenceNames(CurRoot,ReferenceRootNames); + Result:=mrOk; for i:=0 to ReferenceRootNames.Count-1 do begin RefRootName:=ReferenceRootNames[i]; ReferenceInstanceNames.Clear; GetFixupInstanceNames(CurRoot,RefRootName,ReferenceInstanceNames); - DebugLn(['TMainIDE.DoFixupComponentReferences ',i,' RefRoot=',RefRootName,' Refs="',ReferenceInstanceNames.Text,'"']); + //DebugLn(['TMainIDE.DoFixupComponentReferences ',i,' ',dbgsName(CurRoot),' RefRoot=',RefRootName,' Refs="',Trim(ReferenceInstanceNames.Text),'"']); + + {$IFDEF EnableMultiFormProperties} + // load the referenced component + Result:=LoadDependencyHidden(RefRootName); + {$ENDIF} + ReferenceInstanceNames.Clear; + GetFixupInstanceNames(CurRoot,RefRootName,ReferenceInstanceNames); + //DebugLn(['TMainIDE.DoFixupComponentReferences AAA2 ',i,' ',dbgsName(CurRoot),' RefRoot=',RefRootName,' Refs="',Trim(ReferenceInstanceNames.Text),'"']); + // forget the rest of the dangling references RemoveFixupReferences(CurRoot,RefRootName); + + if Result<>mrOk then begin + // ToDo: give a nice error message and give user the choice between + // a) ignore and loose the references + // b) undo the opening (close the designer forms) + end; end; finally ReferenceRootNames.Free; ReferenceInstanceNames.Free; + UsedUnitFilenames.Free; + ComponentNameToUnitFilename.Free; end; - - Result:=mrOk; end; function TMainIDE.DoLoadComponentDependencyHidden(AnUnitInfo: TUnitInfo; @@ -5738,6 +5860,12 @@ begin CTErrorCode:=nil; CTErrorLine:=0; CTErrorCol:=0; + + if (AComponentClassName='') or (not IsValidIdent(AComponentClassName)) then + begin + DebugLn(['TMainIDE.DoLoadComponentDependencyHidden invalid component class name "',AComponentClassName,'"']); + exit(mrCancel); + end; // check for circles if AnUnitInfo.LoadingComponent then begin diff --git a/ide/project.pp b/ide/project.pp index df66164cca..5c0804662f 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -3630,7 +3630,8 @@ end; function TProject.UnitWithComponentName(AComponentName: String): TUnitInfo; begin Result := fFirst[uilPartOfProject]; - while (Result<>nil) and (SysUtils.CompareText(Result.ComponentName, AComponentName) <> 0) do + while (Result<>nil) + and (SysUtils.CompareText(Result.ComponentName, AComponentName) <> 0) do Result := Result.fNext[uilPartOfProject]; end; diff --git a/lcl/lresources.pp b/lcl/lresources.pp index 7d00065d6f..efeea28bf9 100644 --- a/lcl/lresources.pp +++ b/lcl/lresources.pp @@ -338,8 +338,10 @@ function LFMtoLRSstream(LFMStream, LRSStream: TStream): boolean;// true on succe function FindLFMClassName(LFMStream: TStream):AnsiString; procedure ReadLFMHeader(LFMStream: TStream; out LFMType, LFMComponentName, LFMClassName: String); -procedure ReadLFMHeader(const LFMSource: string; out LFMClassName: String; - out LFMType: String); +procedure ReadLFMHeader(const LFMSource: string; + out LFMClassName: String; out LFMType: String); +procedure ReadLFMHeader(const LFMSource: string; + out LFMType, LFMComponentName, LFMClassName: String); function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer; type @@ -1742,36 +1744,51 @@ begin LFMStream.Position:=0; end; -procedure ReadLFMHeader(const LFMSource: string; out LFMClassName: String; - out LFMType: String); +procedure ReadLFMHeader(const LFMSource: string; + out LFMClassName: String; out LFMType: String); +var + LFMComponentName: string; +begin + ReadLFMHeader(LFMSource,LFMType,LFMComponentName,LFMClassName); +end; + +procedure ReadLFMHeader(const LFMSource: string; out LFMType, LFMComponentName, + LFMClassName: String); var p: Integer; - LineEndPos: LongInt; + StartPos: LongInt; begin { examples: object Form1: TForm1 inherited AboutBox2: TAboutBox2 - - LFMClassName is the last word of the first line - LFMType is the first word on the line + - LFMComponentName is the second word + - LFMClassName is the fourth token } - LFMClassName := ''; - + // read first word => LFMType p:=1; while (p<=length(LFMSource)) and (LFMSource[p] in ['a'..'z','A'..'Z','0'..'9','_']) do inc(p); LFMType:=copy(LFMSource,1,p-1); + + // read second word => LFMComponentName + while (p<=length(LFMSource)) and (LFMSource[p] in [' ',#9]) do inc(p); + StartPos:=p; + while (p<=length(LFMSource)) + and (LFMSource[p] in ['a'..'z','A'..'Z','0'..'9','_']) do + inc(p); + LFMComponentName:=copy(LFMSource,StartPos,p-StartPos); - // find end of line - while (p<=length(LFMSource)) and (not (LFMSource[p] in [#10,#13])) do inc(p); - LineEndPos:=p; - // read last word => LFMClassName - while (p>1) - and (LFMSource[p-1] in ['a'..'z','A'..'Z','0'..'9','_']) do - dec(p); - LFMClassName:=copy(LFMSource,p,LineEndPos-p); + // read third word => LFMClassName + while (p<=length(LFMSource)) and (LFMSource[p] in [' ',#9,':']) do inc(p); + StartPos:=p; + while (p<=length(LFMSource)) + and (LFMSource[p] in ['a'..'z','A'..'Z','0'..'9','_']) do + inc(p); + LFMClassName:=copy(LFMSource,StartPos,p-StartPos); end; function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer; diff --git a/packager/pkgmanager.pas b/packager/pkgmanager.pas index 2df2761658..b9120da056 100644 --- a/packager/pkgmanager.pas +++ b/packager/pkgmanager.pas @@ -4073,7 +4073,8 @@ begin end; end; -function TPkgManager.FindReferencedRootComponent(CurRoot: TPersistent; const ComponentName: string): TComponent; +function TPkgManager.FindReferencedRootComponent(CurRoot: TPersistent; + const ComponentName: string): TComponent; var UnitList: TFPList; ARoot: TComponent; @@ -4088,7 +4089,7 @@ begin for i := 0 to UnitList.Count - 1 do begin ARoot := TUnitInfo(UnitList[i]).Component; - //DebugLn(dbgsName(ARoot)); + DebugLn(['TPkgManager.FindReferencedRootComponent Root=',dbgsName(CurRoot),' Searched="',ComponentName,'" other root=',dbgsName(ARoot)]); if (ARoot <> nil) and (SysUtils.CompareText(ComponentName, ARoot.Name) = 0) then begin Result := ARoot;