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

IDE: store ResourceBaseClassName of designer components, added DesignerClassCanAppCreateForm

Browse Source
This commit is contained in:
mattias 2023-09-24 14:28:26 +02:00
parent 6a2c1915dc
commit ba1f89639b
6 changed files with 186 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/ideintf/formeditingintf.pas
View File

@ -191,13 +191,13 @@ type
private
FNonFormProxyDesignerFormClass: array[0..1] of TNonFormProxyDesignerFormClass;
protected
function GetDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
procedure SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass); virtual; abstract;
function GetDesigner(Index: integer): TIDesigner; virtual; abstract;
function GetDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
function GetDesignerMediators(Index: integer): TDesignerMediatorClass; virtual; abstract;
function GetNonFormProxyDesignerForm(Index: Integer): TNonFormProxyDesignerFormClass; virtual;
function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
procedure SetNonFormProxyDesignerForm(Index: Integer; AValue: TNonFormProxyDesignerFormClass); virtual;
procedure SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass); virtual; abstract;
public
constructor Create;
// persistent
@ -245,6 +245,8 @@ type
function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
function DescendFromDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; virtual; abstract;
function DesignerClassCanAppCreateForm(AClass: TComponentClass; CheckInherited: boolean = true): boolean; virtual; abstract;
procedure SetDesignerBaseClassCanAppCreateForm(AClass: TComponentClass; Value: boolean); virtual; abstract;
property StandardDesignerBaseClasses[Index: integer]: TComponentClass read GetStandardDesignerBaseClasses
write SetStandardDesignerBaseClasses;

58
ide/customformeditor.pp
View File

@ -76,6 +76,7 @@ type
FDesignerBaseClasses: TFPList; // list of TComponentClass
FDesignerMediatorClasses: TFPList;// list of TDesignerMediatorClass
FOnNodeGetImageIndex: TOnOINodeGetImageEvent;
FDesignerBaseClassesCanCreateForm: TFPList; // list of TComponentClass
function GetPropertyEditorHook: TPropertyEditorHook;
function FindDefinePropertyNode(const APersistentClassName: string
): TAvlTreeNode;
@ -181,6 +182,10 @@ type
function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
function DescendFromDesignerBaseClass(AClass: TComponentClass): integer; override;
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override; // can be UnitName/ClassName
function DesignerClassCanAppCreateForm(AClass: TComponentClass;
CheckInherited: boolean=true): boolean; override;
procedure SetDesignerBaseClassCanAppCreateForm(AClass: TComponentClass;
AValue: boolean); override;
function StandardDesignerBaseClassesCount: Integer; override;
// designers
@ -497,6 +502,7 @@ begin
FNonFormForms := TAvlTree.Create(@CompareNonFormDesignerForms);
FSelection := TPersistentSelectionList.Create;
FDesignerBaseClasses:=TFPList.Create;
FDesignerBaseClassesCanCreateForm:=TFPList.Create;
FDesignerMediatorClasses:=TFPList.Create;
for l:=0 to StandardDesignerBaseClassesCount - 1 do
FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);
@ -529,6 +535,7 @@ begin
FreeAndNil(JITFormList);
FreeAndNil(JITNonFormList);
FreeAndNil(FDesignerMediatorClasses);
FreeAndNil(FDesignerBaseClassesCanCreateForm);
FreeAndNil(FDesignerBaseClasses);
FreeAndNil(FSelection);
FreeAndNil(FNonFormForms);
@ -1878,11 +1885,19 @@ begin
end;
function TCustomFormEditor.DescendFromDesignerBaseClass(AClass: TComponentClass): integer;
var
i: Integer;
begin
Result:=FDesignerBaseClasses.Count-1;
while (Result>=0)
and (not AClass.InheritsFrom(TClass(FDesignerBaseClasses[Result]))) do
dec(Result);
Result:=-1;
for i:=0 to FDesignerBaseClasses.Count-1 do
begin
if AClass.InheritsFrom(TClass(FDesignerBaseClasses[i])) then
begin
if (Result<0)
or (TClass(FDesignerBaseClassesCanCreateForm[i]).InheritsFrom(TClass(FDesignerBaseClasses[Result]))) then
Result:=i;
end;
end;
end;
function TCustomFormEditor.FindDesignerBaseClassByName(
@ -2204,6 +2219,41 @@ begin
end;
end;
function TCustomFormEditor.DesignerClassCanAppCreateForm(
AClass: TComponentClass; CheckInherited: boolean): boolean;
var
i: Integer;
begin
Result:=false;
if AClass=nil then exit;
// check standard classes
if (AClass=TCustomForm) or (AClass=TDataModule) then
exit(true);
if CheckInherited and (AClass.InheritsFrom(TCustomForm) or AClass.InheritsFrom(TDataModule)) then
exit(true);
// check addons
Result:=FDesignerBaseClassesCanCreateForm.IndexOf(AClass)>=0;
if CheckInherited then
begin
for i:=0 to FDesignerBaseClassesCanCreateForm.Count-1 do
if AClass.InheritsFrom(TComponentClass(FDesignerBaseClassesCanCreateForm[i])) then
exit(true);
end;
end;
procedure TCustomFormEditor.SetDesignerBaseClassCanAppCreateForm(
AClass: TComponentClass; AValue: boolean);
begin
if AValue then
begin
if FDesignerBaseClassesCanCreateForm.IndexOf(AClass)>=0 then exit;
FDesignerBaseClassesCanCreateForm.Add(AClass);
end else begin
if FDesignerBaseClassesCanCreateForm.IndexOf(AClass)<0 then exit;
FDesignerBaseClassesCanCreateForm.Remove(AClass);
end;
end;
function TCustomFormEditor.FindNonFormFormNode(LookupRoot: TComponent): TAvlTreeNode;
begin
Result := FNonFormForms.FindKey(Pointer(LookupRoot),

9
ide/project.pp
View File

@ -295,6 +295,7 @@ type
fOnLoadSaveFilename: TOnLoadSaveFilename;
FOnUnitNameChange: TOnUnitNameChange;
FProject: TProject;
FResourceBaseClassname: string;
FRevertLockCount: integer;// >0 means IDE is currently reverting this unit
fSource: TCodeBuffer;
FSourceLFM: TCodeBuffer;
@ -465,6 +466,7 @@ type
property ComponentState: TWindowState read FComponentState write FComponentState;
property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass
write FResourceBaseClass;
property ResourceBaseClassname: string read FResourceBaseClassname write FResourceBaseClassname;
property ComponentLastBinStreamSize: TStreamSeekType
read FComponentLastBinStreamSize write FComponentLastBinStreamSize;
property ComponentLastLRSStreamSize: TStreamSeekType
@ -1107,7 +1109,7 @@ type
write SetActiveBuildMode;
property ActiveWindowIndexAtStart: integer read FActiveWindowIndexAtStart
write FActiveWindowIndexAtStart;
property AutoCreateForms: boolean read FAutoCreateForms write FAutoCreateForms;
property AutoCreateForms: boolean read FAutoCreateForms write FAutoCreateForms; // add CreateForm for new forms
property AutoOpenDesignerFormsDisabled: boolean read FAutoOpenDesignerFormsDisabled
write SetAutoOpenDesignerFormsDisabled;
property Bookmarks: TProjectBookmarkList read FBookmarks write FBookmarks;
@ -1852,6 +1854,9 @@ begin
XMLConfig.SetDeleteValue(Path+'ResourceBaseClass/Value',
PFComponentBaseClassNames[FResourceBaseClass],
PFComponentBaseClassNames[pfcbcNone]);
XMLConfig.SetDeleteValue(Path+'ResourceBaseClassname/Value',
FResourceBaseClassname,
DefaultResourceBaseClassnames[FResourceBaseClass]);
s:=FUnitName;
if (s<>'') and (ExtractFileNameOnly(Filename)=s) then s:=''; // only save if UnitName differs from filename
XMLConfig.SetDeleteValue(Path+'UnitName/Value',s,'');
@ -1926,6 +1931,8 @@ begin
HasResources:=XMLConfig.GetValue(Path+'HasResources/Value',false);
FResourceBaseClass:=StrToComponentBaseClass(
XMLConfig.GetValue(Path+'ResourceBaseClass/Value',''));
FResourceBaseClassname:=XMLConfig.GetValue(Path+'ResourceBaseClassname/Value',
DefaultResourceBaseClassnames[FResourceBaseClass]);
if not IgnoreIsPartOfProject then
IsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false);
AFilename:=XMLConfig.GetValue(Path+'ResourceFilename/Value','');

89
ide/projectinspector.pas
View File

@ -69,7 +69,7 @@ uses
ProjectIntf, PackageIntf, PackageLinkIntf, PackageDependencyIntf,
// IDEIntf
IDEHelpIntf, IDECommands, IDEDialogs, IDEImagesIntf, LazIDEIntf, ToolBarIntf,
IdeIntfStrConsts, MenuIntf, InputHistory,
IdeIntfStrConsts, MenuIntf, FormEditingIntf, InputHistory,
// IdeConfig
EnvironmentOpts, IDEOptionDefs, TransferMacros, IDEProcs,
// IDE
@ -315,6 +315,15 @@ implementation
{$R *.lfm}
function UpdateUnitInfoResourceBaseClass(AnUnitInfo: TUnitInfo; Quiet: boolean): boolean;
procedure ClearUnitResInfo;
begin
AnUnitInfo.ResourceBaseClass:=pfcbcNone;
AnUnitInfo.ResourceBaseClassname:='';
AnUnitInfo.ComponentName:='';
AnUnitInfo.ComponentResourceName:='';
end;
var
LFMFilename, LFMType, Ancestor, LFMClassName, LFMComponentName: String;
LFMCode, Code: TCodeBuffer;
@ -325,6 +334,7 @@ var
ListOfPFindContext: TFPList;
i: Integer;
Context: PFindContext;
CompClass, aDesignerBaseClass: TComponentClass;
begin
Result:=false;
if AnUnitInfo.Component<>nil then
@ -343,18 +353,14 @@ begin
exit(true); // no lfm -> clear info
finally
if ClearOldInfo then begin
AnUnitInfo.ResourceBaseClass:=pfcbcNone;
AnUnitInfo.ComponentName:='';
AnUnitInfo.ComponentResourceName:='';
ClearUnitResInfo;
end;
end;
try
if not FilenameExtIs(LFMFilename,'lfm',true) then
exit(true); // no lfm format -> keep old info
// clear old info
AnUnitInfo.ResourceBaseClass:=pfcbcNone;
AnUnitInfo.ComponentName:='';
AnUnitInfo.ComponentResourceName:='';
ClearUnitResInfo;
// load lfm
LoadFileFlags:=[lbfUpdateFromDisk,lbfCheckIfText];
if Quiet then
@ -376,6 +382,7 @@ begin
CodeToolBoss.Explore(Code,Tool,false,true);
if Tool=nil then
exit; // pas load error
aDesignerBaseClass:=nil;
try
Node:=Tool.FindDeclarationNodeInInterface(LFMClassName,true);
if Node=nil then
@ -391,37 +398,59 @@ begin
for i:=0 to ListOfPFindContext.Count-1 do begin
Context:=PFindContext(ListOfPFindContext[i]);
Ancestor:=UpperCase(Context^.Tool.ExtractClassName(Context^.Node,false));
if (Ancestor='TFORM') then begin
AnUnitInfo.ResourceBaseClass:=pfcbcForm;
case Ancestor of
'TFORM':
begin
AnUnitInfo.ResourceBaseClass:=pfcbcForm;
aDesignerBaseClass:=TForm;
end;
'TCUSTOMFORM':
begin
AnUnitInfo.ResourceBaseClass:=pfcbcCustomForm;
aDesignerBaseClass:=TCustomForm;
end;
'TDATAMODULE':
begin
AnUnitInfo.ResourceBaseClass:=pfcbcDataModule;
aDesignerBaseClass:=TDataModule;
end;
'TFRAME':
begin
AnUnitInfo.ResourceBaseClass:=pfcbcFrame;
aDesignerBaseClass:=TFrame;
end;
'TCUSTOMFRAME':
begin
AnUnitInfo.ResourceBaseClass:=pfcbcFrame;
aDesignerBaseClass:=TCustomFrame;
end;
'TCOMPONENT':
begin
CompClass:=FormEditingHook.FindDesignerBaseClassByName(Ancestor,false);
if CompClass<>nil then
begin
AnUnitInfo.ResourceBaseClass:=pfcbcOther;
aDesignerBaseClass:=CompClass;
end;
end;
end;
if aDesignerBaseClass<>nil then
begin
AnUnitInfo.ResourceBaseClassname:=aDesignerBaseClass.ClassName;
Result:=true;
Break;
end else if (Ancestor='TCUSTOMFORM') then begin
AnUnitInfo.ResourceBaseClass:=pfcbcCustomForm;
Result:=true;
Break;
end else if Ancestor='TDATAMODULE' then begin
AnUnitInfo.ResourceBaseClass:=pfcbcDataModule;
Result:=true;
Break;
end else if (Ancestor='TFRAME') or (Ancestor='TCUSTOMFRAME') then begin
AnUnitInfo.ResourceBaseClass:=pfcbcFrame;
Result:=true;
Break;
end else if Ancestor='TCOMPONENT' then begin
Result:=true;
Break;
break;
end;
end;
if aDesignerBaseClass=nil then exit;
except
exit; // syntax error or unit not found
end;
if not Result then exit;
// Maybe auto-create it
// (pfMainUnitHasCreateFormStatements in Project1.Flags)
// and Project1.AutoCreateForms are checked by caller.
if (AnUnitInfo.ResourceBaseClass in [pfcbcForm,pfcbcCustomForm,pfcbcDataModule])
and (LFMComponentName<>'')
if (LFMComponentName<>'')
and (pfMainUnitHasCreateFormStatements in Project1.Flags)
and Project1.AutoCreateForms
and FormEditingHook.DesignerClassCanAppCreateForm(aDesignerBaseClass)
and (IDEMessageDialog(lisAddToStartupComponents,
Format(lisShouldTheComponentBeAutoCreatedWhenTheApplicationS,
[LFMComponentName]),

42
ide/sourcefilemanager.pas
View File

@ -268,7 +268,7 @@ procedure CompleteUnitComponent(AnUnitInfo: TUnitInfo;
function RemoveFilesFromProject(UnitInfos: TFPList): TModalResult;
function AskSaveProject(const ContinueText, ContinueBtn: string): TModalResult;
function SaveEditorChangesToCodeCache(AEditor: TSourceEditorInterface): boolean;
function GetDsgnComponentBaseClassname(aCompClass: TClass): string;
// These are local functions. Forward reference is needed for most of them.
// function AskToSaveEditors(EditorList: TList): TModalResult;
@ -2287,12 +2287,16 @@ begin
LRSFilename:=ChangeFileExt(NewUnitInfo.Filename,'.lrs');
CodeToolBoss.CreateFile(LRSFilename);
end;
if ((NewUnitInfo.Component is TCustomForm) or (NewUnitInfo.Component is TDataModule))
//debugln(['NewFile custom LFM: ',DbgSName(NewUnitInfo.Component),' NewFileDescriptor.UseCreateFormStatements=',NewFileDescriptor.UseCreateFormStatements,' NewUnitInfo.IsPartOfProject=',NewUnitInfo.IsPartOfProject,' AProject.AutoCreateForms=',AProject.AutoCreateForms,' pfMainUnitHasCreateFormStatements=',pfMainUnitHasCreateFormStatements in AProject.Flags,' DesignerClassCanAppCreateForm=',(NewUnitInfo.Component<>nil) and (FormEditingHook.DesignerClassCanAppCreateForm(TComponentClass(NewUnitInfo.Component.ClassType)))]);
if (NewUnitInfo.Component<>nil)
and NewFileDescriptor.UseCreateFormStatements
and NewUnitInfo.IsPartOfProject
and AProject.AutoCreateForms
and (pfMainUnitHasCreateFormStatements in AProject.Flags) then
begin
and (pfMainUnitHasCreateFormStatements in AProject.Flags)
and FormEditingHook.DesignerClassCanAppCreateForm(
TComponentClass(NewUnitInfo.Component.ClassType))
then begin
AProject.AddCreateFormToProjectFile(NewUnitInfo.Component.ClassName,
NewUnitInfo.Component.Name);
end;
@ -4586,6 +4590,7 @@ begin
and (csSetCaption in TControl(NewComponent).ControlStyle) then
TControl(NewComponent).Caption:=NewComponent.Name;
NewUnitInfo.Component := NewComponent;
NewUnitInfo.ResourceBaseClassname:=GetDsgnComponentBaseClassname(NewComponent.ClassType);
MainIDE.CreateDesignerForComponent(NewUnitInfo,NewComponent);
if NewComponent is TCustomDesignControl then
begin
@ -4595,11 +4600,13 @@ begin
NewUnitInfo.ComponentName:=NewComponent.Name;
NewUnitInfo.ComponentResourceName:=NewUnitInfo.ComponentName;
//debugln(['CreateNewForm: ',DbgSName(NewUnitInfo.Component),' UseCreateFormStatements=',UseCreateFormStatements,' NewUnitInfo.IsPartOfProject=',NewUnitInfo.IsPartOfProject,' AProject.AutoCreateForms=',Project1.AutoCreateForms,' pfMainUnitHasCreateFormStatements=',pfMainUnitHasCreateFormStatements in Project1.Flags,' DesignerClassCanAppCreateForm=',(NewUnitInfo.Component<>nil) and (FormEditingHook.DesignerClassCanAppCreateForm(TComponentClass(NewUnitInfo.Component.ClassType)))]);
if UseCreateFormStatements
and ((NewComponent is TCustomForm) or (NewComponent is TDataModule))
and NewUnitInfo.IsPartOfProject
and Project1.AutoCreateForms
and (pfMainUnitHasCreateFormStatements in Project1.Flags) then
and (pfMainUnitHasCreateFormStatements in Project1.Flags)
and FormEditor1.DesignerClassCanAppCreateForm(
TComponentClass(NewComponent.ClassType)) then
begin
Project1.AddCreateFormToProjectFile(NewComponent.ClassName,
NewComponent.Name);
@ -6267,6 +6274,8 @@ begin
Project1.InvalidateUnitComponentDesignerDependencies;
AnUnitInfo.Component:=NewComponent;
if NewComponent<>nil then
AnUnitInfo.ResourceBaseClassname:=GetDsgnComponentBaseClassname(NewComponent.ClassType);
if (AncestorUnitInfo<>nil) then
AnUnitInfo.AddRequiresComponentDependency(AncestorUnitInfo,[ucdtAncestor]);
if NewComponent<>nil then begin
@ -8320,6 +8329,27 @@ begin
end;
end;
function GetDsgnComponentBaseClassname(aCompClass: TClass): string;
var
i: Integer;
begin
Result:='';
if aCompClass=nil then exit;
if aCompClass.InheritsFrom(TForm) then
exit(DefaultResourceBaseClassnames[pfcbcForm])
else if aCompClass=TCustomForm then
exit(DefaultResourceBaseClassnames[pfcbcCustomForm])
else if aCompClass.InheritsFrom(TFrame) then
exit(DefaultResourceBaseClassnames[pfcbcFrame])
else if aCompClass=TCustomFrame then
exit('TCustomFrame')
else if aCompClass.InheritsFrom(TDataModule) then
exit(DefaultResourceBaseClassnames[pfcbcDataModule]);
i:=FormEditingHook.IndexOfDesignerBaseClass(TComponentClass(aCompClass.ClassType));
if i<0 then exit;
Result:=FormEditingHook.DesignerBaseClasses[i].ClassName;
end;
function ReplaceUnitUse(OldFilename, OldUnitName, NewFilename, NewUnitName: string;
IgnoreErrors, Quiet, Confirm: boolean): TModalResult;
// Replaces all references to a unit

30
packager/packagedefs.pas
View File

@ -113,7 +113,8 @@ type
pfcbcForm, // is TForm
pfcbcFrame, // is TFrame
pfcbcDataModule,// is TDataModule
pfcbcCustomForm // is TCustomForm (not TForm)
pfcbcCustomForm,// is TCustomForm (not TForm)
pfcbcOther // is a designer base class, see ResourceBaseClassname
);
const
@ -122,9 +123,18 @@ const
'Form',
'Frame',
'DataModule',
'CustomForm'
'CustomForm',
''
);
DefaultResourceBaseClassnames: array[TPFComponentBaseClass] of string = (
'',
'TForm',
'TFrame',
'TDataModule',
'TCustomForm',
''
);
function StrToComponentBaseClass(const s: string): TPFComponentBaseClass;
function GetComponentBaseClass(aClass: TClass): TPFComponentBaseClass;
@ -150,6 +160,7 @@ type
fFullFilenameStamp: integer;
FPackage: TLazPackage;
FResourceBaseClass: TPFComponentBaseClass;
FResourceBaseClassname: string;
FSourceDirectoryReferenced: boolean;
FSourceDirNeedReference: boolean;
function GetAddToUsesPkgSection: boolean;
@ -196,8 +207,8 @@ type
read GetAddToUsesPkgSection write SetAddToUsesPkgSection;
property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir
write SetAutoReferenceSourceDir;
property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass
write FResourceBaseClass;
property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass write FResourceBaseClass;
property ResourceBaseClassname: string read FResourceBaseClassname write FResourceBaseClassname;
property ComponentPriority: TComponentPriority read FComponentPriority
write FComponentPriority;
property Components[Index: integer]: TPkgComponent read GetComponents;// registered components
@ -1113,7 +1124,9 @@ begin
else if aClass.InheritsFrom(TDataModule) then
Result:=pfcbcDataModule
else if aClass.InheritsFrom(TCustomForm) then
Result:=pfcbcCustomForm;
Result:=pfcbcCustomForm
else
Result:=pfcbcOther;
end;
function CompareLazPackageID(Data1, Data2: Pointer): integer;
@ -1677,6 +1690,8 @@ begin
end;
FResourceBaseClass:=StrToComponentBaseClass(
XMLConfig.GetValue(Path+'ResourceBaseClass/Value',''));
FResourceBaseClassname:=XMLConfig.GetValue(Path+'ResourceBaseClassname/Value',
DefaultResourceBaseClassnames[FResourceBaseClass]);
Config:=TXMLOptionsStorage.Create(XMLConfig);
try
@ -1707,6 +1722,9 @@ begin
XMLConfig.SetDeleteValue(Path+'ResourceBaseClass/Value',
PFComponentBaseClassNames[FResourceBaseClass],
PFComponentBaseClassNames[pfcbcNone]);
XMLConfig.SetDeleteValue(Path+'ResourceBaseClassname/Value',
FResourceBaseClassname,
DefaultResourceBaseClassnames[FResourceBaseClass]);
Config:=TXMLOptionsStorage.Create(XMLConfig);
try