paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-02 20:17:00 +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? // is this ancestor a designer class?
if not FindBaseComponentClass(ClsUnitInfo,AncestorClsName,ClsName,AncestorClass) then if not FindBaseComponentClass(ClsUnitInfo,AncestorClsName,ClsName,AncestorClass) then
begin begin
DebugLn(['LoadAncestorDependencyHidden FindUnitComponentClass failed for AncsClsName=',AncestorClsName]); DebugLn(['Error: (lazarus) [LoadAncestorDependencyHidden] FindBaseComponentClass failed for AncestorClsName=',AncestorClsName]);
exit(mrCancel); exit(mrCancel);
end; end;
if Assigned(AncestorClass) then if Assigned(AncestorClass) then
break begin
else begin // ancestor is a registered designer base class, e.g. TForm or TDataModule
break;
end else begin
// immediately go to next ancestor // immediately go to next ancestor
ClsName:=AncestorClsName; ClsName:=AncestorClsName;
continue; continue;
@ -6815,7 +6817,7 @@ begin
OpenFlags,false,AncestorClass,AncestorUnitInfo,GrandAncestorClass, OpenFlags,false,AncestorClass,AncestorUnitInfo,GrandAncestorClass,
IgnoreBtnText); IgnoreBtnText);
if Result<>mrOk then begin if Result<>mrOk then begin
DebugLn(['LoadAncestorDependencyHidden DoLoadComponentDependencyHidden failed ClsUnitInfo=',ClsUnitInfo.Filename]); DebugLn(['Error: (lazarus) [LoadAncestorDependencyHidden] LoadComponentDependencyHidden failed ClsUnitInfo=',ClsUnitInfo.Filename,' ClsName="',ClsName,'"']);
end; end;
case Result of case Result of
mrAbort: exit; mrAbort: exit;
@ -6835,7 +6837,7 @@ begin
ClsUnitInfo:= AncestorUnitInfo ClsUnitInfo:= AncestorUnitInfo
else begin else begin
// likely a bug: declaration is nowhere and was not caught by user interaction in LoadComponentDependencyHidden // 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); exit(mrCancel);
end; end;
until Assigned(AncestorClass) or (ClsName = '') or not Assigned(ClsUnitInfo); until Assigned(AncestorClass) or (ClsName = '') or not Assigned(ClsUnitInfo);
@ -6934,8 +6936,8 @@ var
if FoundComponentClass=nil then if FoundComponentClass=nil then
begin begin
RegComp:=IDEComponentPalette.FindRegComponent(aClassName); RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
if (RegComp<>nil) and if (RegComp<>nil)
not RegComp.ComponentClass.InheritsFrom(TCustomFrame) then // Nested TFrame and not RegComp.ComponentClass.InheritsFrom(TCustomFrame) then // Nested TFrame
FoundComponentClass:=RegComp.ComponentClass; FoundComponentClass:=RegComp.ComponentClass;
end; end;
if FoundComponentClass=nil then if FoundComponentClass=nil then
@ -6993,7 +6995,7 @@ var
// read the LFM classname // read the LFM classname
ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType); ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
if LFMType='' then ; if LFMType='' then ;
if SysUtils.CompareText(LFMClassName,AClassName)<>0 then if not SameLFMTypeName('',AClassName,LFMClassName) then
begin begin
{$IFDEF VerboseLFMSearch} {$IFDEF VerboseLFMSearch}
debugln([' TryLFM CurLFMFilename="',CurLFMFilename,'" LFMClassName="',LFMClassName,'" does not match']); 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; function ReadLFMHeaderFromFile(const Filename: string;
out LFMType, LFMComponentName, LFMClassName: String): boolean; out LFMType, LFMComponentName, LFMClassName: String): boolean;
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer; function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
function SameLFMTypeName(aUnitname, aTypename, LFMTypename: string): boolean;
type type
TLRSStreamOriginalFormat = (sofUnknown, sofBinary, sofText); TLRSStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
@ -2174,6 +2175,22 @@ begin
end; end;
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 LRSObjectBinaryToText(Input, Output: TStream);
procedure OutStr(const s: String); procedure OutStr(const s: String);