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

ide: QuickCheckLFMBuffer: support unitnames in lfm

Browse Source
This commit is contained in:
mattias 2023-04-11 17:42:52 +02:00
parent 37d638661f
commit c3f0c4009a
4 changed files with 77 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
components/ideintf/componentreg.pas
View File

@ -275,7 +275,7 @@ type
procedure AddRegComponent(NewComponent: TRegisteredComponent);
procedure RemoveRegComponent(AComponent: TRegisteredComponent);
function FindRegComponent(ACompClass: TClass): TRegisteredComponent;
function FindRegComponent(const ACompClassName: string): TRegisteredComponent;
function FindRegComponent(const ACompClassName: string): TRegisteredComponent; // can be UnitName/ClassName
function CreateNewClassName(const Prefix: string): string;
procedure Update({%H-}ForceUpdateAll: Boolean); virtual;
procedure IterateRegisteredClasses(Proc: TGetComponentClassEvent);
@ -1152,18 +1152,29 @@ function TBaseComponentPalette.FindRegComponent(const ACompClassName: string): T
// Return registered component based on LCL component class name.
var
i: Integer;
HasUnitName: Boolean;
aComp: TRegisteredComponent;
CurClassName: String;
begin
// A small optimization. If same type is asked many times, return it quickly.
if ACompClassName = fLastFoundCompClassName then
Exit(fLastFoundRegComp);
// Linear search. Can be optimized if needed.
HasUnitName:=Pos('/',ACompClassName)>0;
for i := 0 to fComps.Count-1 do
if SameText(fComps[i].ComponentClass.ClassName, ACompClassName) then
begin
Result:=fComps[i];
if HasUnitName then
CurClassName:=Result.GetUnitName+'/'+Result.ComponentClass.ClassName
else
CurClassName:=Result.ComponentClass.ClassName;
if SameText(CurClassName, ACompClassName) then
begin
fLastFoundCompClassName := ACompClassName;
fLastFoundRegComp := fComps[i];
Exit(fLastFoundRegComp);
fLastFoundRegComp := Result;
exit;
end;
end;
Result:=nil;
end;

69
ide/checklfmdlg.pas
View File

@ -36,7 +36,7 @@ uses
// LCL
LCLProc, LResources, Forms, Controls, Dialogs, Buttons, StdCtrls, ExtCtrls,
// LazUtils
LazStringUtils,
LazStringUtils, AvgLvlTree,
// CodeTools
BasicCodeTools, CodeCache, CodeToolManager, LFMTrees,
// SynEdit
@ -155,8 +155,12 @@ type
function QuickCheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
out LFMType, LFMComponentName, LFMClassName: string;
out LCLVersion: string; out MissingClasses: TStrings): TModalResult;
const
ClassFound = 'found';
ClassMissing = 'missing';
var
LFMTree: TLFMTree;
Classes: TStringToStringTree;
procedure FindLCLVersion;
var
@ -182,33 +186,47 @@ var
// A nested class means a TFrame installed as a component.
var
i: Integer;
AClassName: String;
AClassName, AnUnitName, AFullName: String;
RegComp: TRegisteredComponent;
begin
AClassName:=ObjNode.TypeName;
// search in already missing classes
if (MissingClasses<>nil) then begin
for i:=0 to MissingClasses.Count-1 do
if SysUtils.CompareText(AClassName,MissingClasses[i])=0 then
exit;
end;
// ToDo: search only in used packages
AnUnitName:=ObjNode.TypeUnitName;
if AnUnitName<>'' then
AFullName:=AnUnitName+'/'+AClassName
else
AFullName:=AClassName;
if Classes[AFullName]<>'' then exit;
// search in designer base classes
if BaseFormEditor1.FindDesignerBaseClassByName(AClassName,true)<>nil then
if BaseFormEditor1.FindDesignerBaseClassByName(AFullName,true)<>nil then
begin
Classes[AFullName]:=ClassFound;
exit;
end;
// search in global registered classes
if GetClass(ObjNode.TypeName)<>nil then
{$IFDEF FPC_FULLVERSION>30300}
if GetClass(AnUnitName,AClassName)<>nil then
{$ELSE}
if GetClass(AClassName)<>nil then
{$ENDIF}
begin
Classes[AFullName]:=ClassFound;
exit;
end;
// search in registered classes
RegComp:=IDEComponentPalette.FindRegComponent(ObjNode.TypeName);
RegComp:=IDEComponentPalette.FindRegComponent(AFullName);
if (RegComp<>nil) and (RegComp.GetUnitName<>'')
and not RegComp.ComponentClass.InheritsFrom(TCustomFrame) then // Nested TFrame
and not RegComp.ComponentClass.InheritsFrom(TCustomFrame) // Nested TFrame
then begin
Classes[AFullName]:=ClassFound;
exit;
end;
// class is missing
DebugLn(['QuickCheckLFMBuffer->FindMissingClass ',ObjNode.Name,':',ObjNode.TypeName,' IsInherited=',ObjNode.IsInherited]);
DebugLn(['QuickCheckLFMBuffer->FindMissingClass ',ObjNode.Name,':',AFullName,' IsInherited=',ObjNode.IsInherited]);
if MissingClasses=nil then
MissingClasses:=TStringList.Create;
MissingClasses.Add(AClassName);
MissingClasses.Add(AFullName);
Classes[AFullName]:=ClassMissing;
end;
procedure FindMissingClasses;
@ -221,15 +239,20 @@ var
// skip root
Node := Node.Next;
// check all other
while Node <> nil do
begin
if Node is TLFMObjectNode then
Classes:=TStringToStringTree.Create(false);
try
while Node <> nil do
begin
FindMissingClass(ObjNode);
Node := Node.Next(ObjNode.IsInline); // skip children if node is inline
end
else
Node := Node.Next;
if Node is TLFMObjectNode then
begin
FindMissingClass(ObjNode);
Node := Node.Next(ObjNode.IsInline); // skip children if node is inline
end
else
Node := Node.Next;
end;
finally
Classes.Free;
end;
end;

21
ide/customformeditor.pp
View File

@ -182,7 +182,7 @@ type
procedure UnregisterDesignerBaseClass(AClass: TComponentClass); override;
function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
function DescendFromDesignerBaseClass(AClass: TComponentClass): integer; override;
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override;
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override; // can be UnitName/ClassName
function StandardDesignerBaseClassesCount: Integer; override;
// designers
@ -1891,34 +1891,43 @@ function TCustomFormEditor.FindDesignerBaseClassByName(
const AClassName: shortstring; WithDefaults: boolean): TComponentClass;
var
i: Integer;
HasUnitName: Boolean;
function Fits(aClass: TComponentClass): boolean;
begin
if HasUnitName then
Result:=SameText(AClass.UnitName+'/'+aClass.ClassName,AClassName)
else
Result:=SameText(aClass.ClassName,AClassName);
end;
function SearchInParent(AParent: TComponentClass): TComponentClass;
begin
Result := nil;
while AParent <> nil do
begin
if CompareText(AClassName, AParent.ClassName)=0 then
if Fits(AParent) then
Exit(AParent);
AParent:=TComponentClass(AParent.ClassParent);
if AParent = TComponent then
Exit;
exit;
end;
end;
begin
HasUnitName:=Pos('/',AClassName)>0;
if WithDefaults then
begin
for i := 0 to StandardDesignerBaseClassesCount - 1 do
begin
Result := SearchInParent(StandardDesignerBaseClasses[i]);
if Result <> nil then
Exit(StandardDesignerBaseClasses[i]);
if Result <> nil then exit;
end;
end;
for i:=FDesignerBaseClasses.Count-1 downto 0 do
begin
Result:=DesignerBaseClasses[i];
if CompareText(Result.ClassName,AClassName)=0 then exit;
if Fits(Result) then exit;
end;
Result:=nil;
end;

25
packager/pkgmanager.pas
View File

@ -361,10 +361,6 @@ type
// components
function AddUnitDepsForCompClasses(const UnitFilename: string;
ComponentClasses: TClassList; Quiet: boolean): TModalResult; override;
{ function GetMissingDependenciesForUnit(const UnitFilename: string;
ComponentClassnames: TStrings;
var List: TOwnerPackageArray): TModalResult;
}
function GetUsableComponentUnits(CurRoot: TPersistent): TFPList; override; // list of TUnitInfo
procedure IterateComponentNames(CurRoot: TPersistent; TypeData: PTypeData;
Proc: TGetStrProc); override;
@ -4663,26 +4659,7 @@ begin
end;
Result:=mrOk;
end;
{
function TPkgManager.GetMissingDependenciesForUnit(
const UnitFilename: string; ComponentClassnames: TStrings;
var List: TOwnerPackageArray): TModalResult;
// returns a list of packages needed to use the Component in the unit
var
AllPackages: TPackagePackageArray;
AllUnits: TStringList;
begin
List:=nil;
Result:=GetUnitsAndDependenciesForComponents(ComponentClassnames,AllPackages,AllUnits);
try
if Result<>mrOK then Exit;
Result:=FilterMissingDependenciesForUnit(UnitFilename,AllPackages,List);
finally
AllPackages.Free;
AllUnits.Free;
end;
end;
}
function TPkgManager.GetOwnersOfUnit(const UnitFilename: string): TFPList;
begin
Result:=GetPossibleOwnersOfUnit(UnitFilename,[]);