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

ide: fixed search ancestor lfm for lfm with unitnames

Browse Source
This commit is contained in:
mattias 2023-08-22 16:25:56 +02:00
parent 5763fb14c6
commit b59196e223
2 changed files with 27 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
ide/sourcefilemanager.pas
View File

@ -6796,13 +6796,15 @@ begin
// is this ancestor a designer class?
if not FindBaseComponentClass(ClsUnitInfo,AncestorClsName,ClsName,AncestorClass) then
begin
DebugLn(['LoadAncestorDependencyHidden FindUnitComponentClass failed for AncsClsName=',AncestorClsName]);
DebugLn(['Error: (lazarus) [LoadAncestorDependencyHidden] FindBaseComponentClass failed for AncestorClsName=',AncestorClsName]);
exit(mrCancel);
end;
if Assigned(AncestorClass) then
break
else begin
begin
// ancestor is a registered designer base class, e.g. TForm or TDataModule
break;
end else begin
// immediately go to next ancestor
ClsName:=AncestorClsName;
continue;
@ -6815,7 +6817,7 @@ begin
OpenFlags,false,AncestorClass,AncestorUnitInfo,GrandAncestorClass,
IgnoreBtnText);
if Result<>mrOk then begin
DebugLn(['LoadAncestorDependencyHidden DoLoadComponentDependencyHidden failed ClsUnitInfo=',ClsUnitInfo.Filename]);
DebugLn(['Error: (lazarus) [LoadAncestorDependencyHidden] LoadComponentDependencyHidden failed ClsUnitInfo=',ClsUnitInfo.Filename,' ClsName="',ClsName,'"']);
end;
case Result of
mrAbort: exit;
@ -6835,7 +6837,7 @@ begin
ClsUnitInfo:= AncestorUnitInfo
else begin
// likely a bug: declaration is nowhere and was not caught by user interaction in LoadComponentDependencyHidden
DebugLn(['LoadAncestorDependencyHidden DoLoadComponentDependencyHidden empty returns for ClsName=',ClsName, ' ClsUnitInfo=',ClsUnitInfo.Filename]);
DebugLn(['Error: (lazarus) [LoadAncestorDependencyHidden] LoadComponentDependencyHidden empty returns for ClsName=',ClsName, ' ClsUnitInfo=',ClsUnitInfo.Filename]);
exit(mrCancel);
end;
until Assigned(AncestorClass) or (ClsName = '') or not Assigned(ClsUnitInfo);
@ -6934,8 +6936,8 @@ var
if FoundComponentClass=nil then
begin
RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
if (RegComp<>nil) and
not RegComp.ComponentClass.InheritsFrom(TCustomFrame) then // Nested TFrame
if (RegComp<>nil)
and not RegComp.ComponentClass.InheritsFrom(TCustomFrame) then // Nested TFrame
FoundComponentClass:=RegComp.ComponentClass;
end;
if FoundComponentClass=nil then
@ -6993,7 +6995,7 @@ var
// read the LFM classname
ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
if LFMType='' then ;
if SysUtils.CompareText(LFMClassName,AClassName)<>0 then
if not SameLFMTypeName('',AClassName,LFMClassName) then
begin
{$IFDEF VerboseLFMSearch}
debugln([' TryLFM CurLFMFilename="',CurLFMFilename,'" LFMClassName="',LFMClassName,'" does not match']);

17
lcl/lresources.pp
View File

@ -527,6 +527,7 @@ procedure ReadLFMHeader(const LFMSource: string;
function ReadLFMHeaderFromFile(const Filename: string;
out LFMType, LFMComponentName, LFMClassName: String): boolean;
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
function SameLFMTypeName(aUnitname, aTypename, LFMTypename: string): boolean;
type
TLRSStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
@ -2174,6 +2175,22 @@ begin
end;
end;
function SameLFMTypeName(aUnitname, aTypename, LFMTypename: string): boolean;
var
p: SizeInt;
begin
p:=Pos('/',LFMTypename);
if p>0 then
begin
if aUnitname<>'' then
Result:=CompareText(aUnitname+'/'+aTypename,LFMTypename)=0
else
Result:=CompareText(aTypename,copy(LFMTypename,p+1,length(LFMTypename)))=0;
end else begin
Result:=CompareText(aTypename,LFMTypename)=0;
end;
end;
procedure LRSObjectBinaryToText(Input, Output: TStream);
procedure OutStr(const s: String);