mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 10:09:25 +02:00
implemented LCL and FCL packages, started package registration
git-svn-id: trunk@4014 -
This commit is contained in:
mattias
parent
1127317f62
commit
937b0a3e47
@ -338,7 +338,7 @@ begin
|
||||
RegisterComponents('Additional','Grids',[TStringGrid,TDrawGrid]);
|
||||
|
||||
// Common
|
||||
RegisterComponents('Common Controls','ImgList',[TImageList]);
|
||||
RegisterComponents('Common Controls','Controls',[TImageList]);
|
||||
RegisterComponents('Common Controls','ComCtrls',[TTrackbar, TProgressBar,
|
||||
TTreeView, TListView, TStatusBar, TToolBar, TUpDown]);
|
||||
|
||||
|
||||
@ -53,6 +53,8 @@ type
|
||||
procedure ConnectSourceNotebookEvents; virtual; abstract;
|
||||
procedure SetupMainBarShortCuts; virtual; abstract;
|
||||
|
||||
procedure LoadInstalledPackages; virtual; abstract;
|
||||
|
||||
function ShowConfigureCustomComponents: TModalResult; virtual; abstract;
|
||||
function DoNewPackage: TModalResult; virtual; abstract;
|
||||
end;
|
||||
|
||||
@ -46,7 +46,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, Laz_XMLCfg, CompilerOptions, Forms, FileCtrl,
|
||||
IDEProcs;
|
||||
IDEProcs, ComponentReg;
|
||||
|
||||
type
|
||||
TLazPackage = class;
|
||||
@ -55,6 +55,22 @@ type
|
||||
TPkgDependency = class;
|
||||
|
||||
|
||||
{ TPkgComponent }
|
||||
|
||||
TPkgComponent = class(TIDEComponent)
|
||||
private
|
||||
FPkgFile: TPkgFile;
|
||||
public
|
||||
constructor Create(ThePkgFile: TPkgFile; TheComponentClass: TComponentClass;
|
||||
const ThePageName: string);
|
||||
function GetUnitName: string; override;
|
||||
function GetPriority: integer; override;
|
||||
procedure ConsistencyCheck; override;
|
||||
public
|
||||
property PkgFile: TPkgFile read FPkgFile write FPkgFile;
|
||||
end;
|
||||
|
||||
|
||||
{ TPkgVersion }
|
||||
|
||||
TPkgVersion = class
|
||||
@ -70,28 +86,7 @@ type
|
||||
function Compare(Version2: TPkgVersion): integer;
|
||||
procedure Assign(Source: TPkgVersion);
|
||||
function AsString: string;
|
||||
end;
|
||||
|
||||
|
||||
{ TPkgComponent }
|
||||
|
||||
TPkgComponent = class
|
||||
private
|
||||
FComponentClass: TComponentClass;
|
||||
FDefaultCompClassName: string;
|
||||
FPkgFile: TPkgFile;
|
||||
procedure SetDefaultCompClassName(const AValue: string);
|
||||
public
|
||||
constructor Create(ThePkgFile: TPkgFile; TheComponentClass: TComponentClass;
|
||||
const TheDefCompClassName: string);
|
||||
destructor Destroy; override;
|
||||
function GetComponentClassName: string;
|
||||
procedure ConsistencyCheck;
|
||||
public
|
||||
property ComponentClass: TComponentClass read FComponentClass;
|
||||
property DefaultCompClassName: string read FDefaultCompClassName
|
||||
write SetDefaultCompClassName;
|
||||
property PkgFile: TPkgFile read FPkgFile;
|
||||
procedure SetValues(NewMajor, NewMinor, NewBuild, NewRelease: integer);
|
||||
end;
|
||||
|
||||
|
||||
@ -111,6 +106,7 @@ type
|
||||
|
||||
TPkgFile = class
|
||||
private
|
||||
FComponentPriority: integer;
|
||||
FFilename: string;
|
||||
FFileType: TPkgFileType;
|
||||
FFlags: TPkgFileFlags;
|
||||
@ -131,7 +127,6 @@ type
|
||||
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
|
||||
procedure ConsistencyCheck;
|
||||
function IsVirtual: boolean;
|
||||
function UnitName: string;
|
||||
public
|
||||
property Filename: string read FFilename write SetFilename;
|
||||
property FileType: TPkgFileType read FFileType write SetFileType;
|
||||
@ -139,6 +134,9 @@ type
|
||||
property HasRegisteredProc: boolean
|
||||
read GetHasRegisteredProc write SetHasRegisteredProc;
|
||||
property LazPackage: TLazPackage read FPackage;
|
||||
property UnitName: string read FUnitName write FUnitName;
|
||||
property ComponentPriority: integer read FComponentPriority
|
||||
write FComponentPriority;
|
||||
end;
|
||||
|
||||
|
||||
@ -211,9 +209,15 @@ type
|
||||
TIterateComponentClassesEvent =
|
||||
procedure(PkgComponent: TPkgComponent) of object;
|
||||
|
||||
TPkgDependencyType = (
|
||||
pdtRequired,
|
||||
pdtConflict
|
||||
);
|
||||
|
||||
TLazPackage = class
|
||||
private
|
||||
FAuthor: string;
|
||||
FAutoCreated: boolean;
|
||||
FAutoLoad: boolean;
|
||||
FComponentCount: integer;
|
||||
FConflictPkgs: TList; // TList of TPkgDependency
|
||||
@ -226,6 +230,7 @@ type
|
||||
FInstalled: boolean;
|
||||
FLoaded: boolean;
|
||||
FPackageEditor: TBasePackageEditor;
|
||||
FReadOnly: boolean;
|
||||
FVersion: TPkgVersion;
|
||||
FFilename: string;
|
||||
FFiles: TList; // TList of TPkgFile
|
||||
@ -255,6 +260,7 @@ type
|
||||
function GetUsedPkgCount: integer;
|
||||
function GetUsedPkgs(Index: integer): TLazPackage;
|
||||
procedure SetAuthor(const AValue: string);
|
||||
procedure SetAutoCreated(const AValue: boolean);
|
||||
procedure SetAutoIncrementVersionOnBuild(const AValue: boolean);
|
||||
procedure SetAutoLoad(const AValue: boolean);
|
||||
procedure SetAutoUpdate(const AValue: boolean);
|
||||
@ -270,6 +276,7 @@ type
|
||||
procedure SetOpen(const AValue: boolean);
|
||||
procedure SetPackageEditor(const AValue: TBasePackageEditor);
|
||||
procedure SetPackageType(const AValue: TLazPackageType);
|
||||
procedure SetReadOnly(const AValue: boolean);
|
||||
procedure SetTitle(const AValue: string);
|
||||
public
|
||||
constructor Create;
|
||||
@ -290,12 +297,22 @@ type
|
||||
function IndexOfPkgComponent(PkgComponent: TPkgComponent): integer;
|
||||
function FindUnit(const TheUnitName: string): TPkgFile;
|
||||
function NameAndVersion: string;
|
||||
function AddFile(const NewFilename, NewUnitName: string;
|
||||
NewFileType: TPkgFileType; NewFlags: TPkgFileFlags;
|
||||
CompPriority: integer): TPkgFile;
|
||||
procedure AddRequiredDependency(Dependency: TPkgDependency);
|
||||
procedure AddConflictDependency(Dependency: TPkgDependency);
|
||||
function CreateDependencyForThisPkg: TPkgDependency;
|
||||
function AddComponent(PkgFile: TPkgFile; const Page: string;
|
||||
TheComponentClass: TComponentClass): TPkgComponent;
|
||||
public
|
||||
property Author: string read FAuthor write SetAuthor;
|
||||
property AutoCreated: boolean read FAutoCreated write SetAutoCreated;
|
||||
property AutoIncrementVersionOnBuild: boolean
|
||||
read GetAutoIncrementVersionOnBuild write SetAutoIncrementVersionOnBuild;
|
||||
property AutoLoad: boolean read FAutoLoad write SetAutoLoad; { dynamic: load package on next IDE start
|
||||
static: compile package into IDE }
|
||||
property AutoLoad: boolean read FAutoLoad write SetAutoLoad; {
|
||||
dynamic: load package on next IDE start
|
||||
static: compile package into IDE }
|
||||
property AutoUpdate: boolean read GetAutoUpdate write SetAutoUpdate;
|
||||
property CompilerOptions: TPkgCompilerOptions
|
||||
read FCompilerOptions;
|
||||
@ -307,6 +324,8 @@ type
|
||||
property DependingPkgs[Index: integer]: TLazPackage read GetDependingPkgs;
|
||||
property Description: string read FDescription write SetDescription;
|
||||
property Directory: string read GetDirectory; // the path of the .lpk file
|
||||
property Editor: TBasePackageEditor read FPackageEditor write SetPackageEditor;
|
||||
property EditorRect: TRect read FEditorRect write SetEditorRect;
|
||||
property FileCount: integer read GetFileCount;
|
||||
property Filename: string read FFilename write SetFilename; // the .lpk filename
|
||||
property Files[Index: integer]: TPkgFile read GetFiles;
|
||||
@ -316,19 +335,18 @@ type
|
||||
property Loaded: boolean read FLoaded write SetLoaded; // package is available for runtime installation
|
||||
property Modified: boolean read GetModified write SetModified;
|
||||
property Name: string read FName write SetName;
|
||||
property Open: boolean read GetOpen write SetOpen; // a packageeditor is open in the IDE
|
||||
property PackageType: TLazPackageType
|
||||
read FPackageType write SetPackageType;
|
||||
property ReadOnly: boolean read FReadOnly write SetReadOnly;
|
||||
property RequiredPkgCount: integer read GetRequiredPkgCount;
|
||||
property RequiredPkgs[Index: integer]: TPkgDependency read GetRequiredPkgs;
|
||||
property UsedPkgCount: integer read GetUsedPkgCount;
|
||||
property UsedPkgs[Index: integer]: TLazPackage read GetUsedPkgs;
|
||||
property Title: string read FTitle write SetTitle;
|
||||
property UsageOptions: TAdditionalCompilerOptions
|
||||
read FUsageOptions;
|
||||
property UsedPkgCount: integer read GetUsedPkgCount;
|
||||
property UsedPkgs[Index: integer]: TLazPackage read GetUsedPkgs;
|
||||
property Version: TPkgVersion read FVersion;
|
||||
property Open: boolean read GetOpen write SetOpen; // a packageeditor is open in the IDE
|
||||
property Editor: TBasePackageEditor read FPackageEditor write SetPackageEditor;
|
||||
property EditorRect: TRect read FEditorRect write SetEditorRect;
|
||||
end;
|
||||
|
||||
|
||||
@ -365,6 +383,7 @@ procedure SortDependencyList(Dependencies: TList);
|
||||
function CompareLazPackage(Data1, Data2: Pointer): integer;
|
||||
function CompareNameWithPackage(Key, Data: Pointer): integer;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -442,9 +461,13 @@ end;
|
||||
{ TPkgFile }
|
||||
|
||||
procedure TPkgFile.SetFilename(const AValue: string);
|
||||
var
|
||||
NewFilename: String;
|
||||
begin
|
||||
if FFilename=AValue then exit;
|
||||
FFilename:=AValue;
|
||||
NewFilename:=AValue;
|
||||
DoDirSeparators(NewFilename);
|
||||
if FFilename=NewFilename then exit;
|
||||
FFilename:=NewFilename;
|
||||
UpdateUnitName;
|
||||
end;
|
||||
|
||||
@ -475,10 +498,14 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPkgFile.UpdateUnitName;
|
||||
var
|
||||
NewUnitName: String;
|
||||
begin
|
||||
if FilenameIsPascalUnit(FFilename) then
|
||||
FUnitName:=ExtractFileNameOnly(FFilename)
|
||||
else
|
||||
if FilenameIsPascalUnit(FFilename) then begin
|
||||
NewUnitName:=ExtractFileNameOnly(FFilename);
|
||||
if AnsiCompareText(NewUnitName,FUnitName)<>0 then
|
||||
FUnitName:=NewUnitName;
|
||||
end else
|
||||
FUnitName:='';
|
||||
end;
|
||||
|
||||
@ -486,6 +513,7 @@ constructor TPkgFile.Create(ThePackage: TLazPackage);
|
||||
begin
|
||||
Clear;
|
||||
FPackage:=ThePackage;
|
||||
FComponentPriority:=CompPriorityNormal;
|
||||
end;
|
||||
|
||||
destructor TPkgFile.Destroy;
|
||||
@ -502,14 +530,17 @@ end;
|
||||
|
||||
procedure TPkgFile.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
FileVersion: integer);
|
||||
var
|
||||
AFilename: String;
|
||||
begin
|
||||
if FileVersion=1 then ;
|
||||
Clear;
|
||||
FFilename:=XMLConfig.GetValue(Path+'Filename/Value','');
|
||||
FPackage.LongenFilename(FFilename);
|
||||
UpdateUnitName;
|
||||
HasRegisteredProc:=XMLConfig.GetValue(Path+'HasRegisteredProc/Value',false);
|
||||
AFilename:=XMLConfig.GetValue(Path+'Filename/Value','');
|
||||
FPackage.LongenFilename(AFilename);
|
||||
Filename:=AFilename;
|
||||
FileType:=PkgFileTypeIdentToType(XMLConfig.GetValue(Path+'Type/Value',''));
|
||||
HasRegisteredProc:=XMLConfig.GetValue(Path+'HasRegisteredProc/Value',false);
|
||||
fUnitName:=XMLConfig.GetValue(Path+'UnitName/Value','');
|
||||
end;
|
||||
|
||||
procedure TPkgFile.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
|
||||
@ -523,6 +554,7 @@ begin
|
||||
false);
|
||||
XMLConfig.SetDeleteValue(Path+'Type/Value',PkgFileTypeIdents[FileType],
|
||||
PkgFileTypeIdents[pftUnit]);
|
||||
XMLConfig.SetDeleteValue(Path+'UnitName/Value',FUnitName,'');
|
||||
end;
|
||||
|
||||
procedure TPkgFile.ConsistencyCheck;
|
||||
@ -538,11 +570,6 @@ begin
|
||||
Result:=FilenameIsAbsolute(FFilename);
|
||||
end;
|
||||
|
||||
function TPkgFile.UnitName: string;
|
||||
begin
|
||||
Result:=FUnitName;
|
||||
end;
|
||||
|
||||
{ TPkgDependency }
|
||||
|
||||
procedure TPkgDependency.SetFlags(const AValue: TPkgDependencyFlags);
|
||||
@ -710,6 +737,15 @@ begin
|
||||
+IntToStr(Release)+'.';
|
||||
end;
|
||||
|
||||
procedure TPkgVersion.SetValues(NewMajor, NewMinor, NewBuild,
|
||||
NewRelease: integer);
|
||||
begin
|
||||
Major:=NewMajor;
|
||||
Minor:=NewMinor;
|
||||
Build:=NewBuild;
|
||||
Release:=NewRelease;
|
||||
end;
|
||||
|
||||
{ TLazPackage }
|
||||
|
||||
function TLazPackage.GetAutoIncrementVersionOnBuild: boolean;
|
||||
@ -799,6 +835,13 @@ begin
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
procedure TLazPackage.SetAutoCreated(const AValue: boolean);
|
||||
begin
|
||||
if FAutoCreated=AValue then exit;
|
||||
FAutoCreated:=AValue;
|
||||
if AutoCreated then ReadOnly:=true;
|
||||
end;
|
||||
|
||||
procedure TLazPackage.SetAutoIncrementVersionOnBuild(const AValue: boolean);
|
||||
begin
|
||||
if AutoIncrementVersionOnBuild=AValue then exit;
|
||||
@ -838,10 +881,17 @@ begin
|
||||
end;
|
||||
|
||||
procedure TLazPackage.SetFilename(const AValue: string);
|
||||
var
|
||||
NewFilename: String;
|
||||
begin
|
||||
if FFilename=AValue then exit;
|
||||
FFilename:=AValue;
|
||||
FDirectory:=ExtractFilePath(FFilename);
|
||||
NewFilename:=AValue;
|
||||
DoDirSeparators(NewFilename);
|
||||
if FFilename=NewFilename then exit;
|
||||
FFilename:=NewFilename;
|
||||
if (FFilename<>'') and (FFilename[length(FFilename)]=PathDelim) then
|
||||
FDirectory:=FFilename
|
||||
else
|
||||
FDirectory:=ExtractFilePath(FFilename);
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
@ -909,6 +959,12 @@ begin
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
procedure TLazPackage.SetReadOnly(const AValue: boolean);
|
||||
begin
|
||||
if FReadOnly=AValue then exit;
|
||||
FReadOnly:=AValue;
|
||||
end;
|
||||
|
||||
procedure TLazPackage.SetTitle(const AValue: string);
|
||||
begin
|
||||
if FTitle=AValue then exit;
|
||||
@ -1198,51 +1254,76 @@ begin
|
||||
Result:=Name+' '+Version.AsString;
|
||||
end;
|
||||
|
||||
function TLazPackage.AddFile(const NewFilename, NewUnitName: string;
|
||||
NewFileType: TPkgFileType; NewFlags: TPkgFileFlags;
|
||||
CompPriority: integer): TPkgFile;
|
||||
begin
|
||||
Result:=TPkgFile.Create(Self);
|
||||
with Result do begin
|
||||
Filename:=NewFilename;
|
||||
UnitName:=NewUnitName;
|
||||
FileType:=NewFileType;
|
||||
Flags:=NewFlags;
|
||||
ComponentPriority:=CompPriority;
|
||||
end;
|
||||
FFiles.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TLazPackage.AddRequiredDependency(Dependency: TPkgDependency);
|
||||
begin
|
||||
FRequiredPkgs.Add(Dependency);
|
||||
end;
|
||||
|
||||
procedure TLazPackage.AddConflictDependency(Dependency: TPkgDependency);
|
||||
begin
|
||||
FConflictPkgs.Add(Dependency);
|
||||
end;
|
||||
|
||||
function TLazPackage.CreateDependencyForThisPkg: TPkgDependency;
|
||||
begin
|
||||
Result:=TPkgDependency.Create;
|
||||
with Result do begin
|
||||
PackageName:=Self.Name;
|
||||
MinVersion.Assign(Version);
|
||||
Flags:=[pdfMinVersion];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazPackage.AddComponent(PkgFile: TPkgFile; const Page: string;
|
||||
TheComponentClass: TComponentClass): TPkgComponent;
|
||||
begin
|
||||
Result:=TPkgComponent.Create(PkgFile,TheComponentClass,Page);
|
||||
FComponents.Add(Result);
|
||||
end;
|
||||
|
||||
{ TPkgComponent }
|
||||
|
||||
procedure TPkgComponent.SetDefaultCompClassName(const AValue: string);
|
||||
begin
|
||||
if FDefaultCompClassName=AValue then exit;
|
||||
FDefaultCompClassName:=AValue;
|
||||
end;
|
||||
|
||||
constructor TPkgComponent.Create(ThePkgFile: TPkgFile;
|
||||
TheComponentClass: TComponentClass; const TheDefCompClassName: string);
|
||||
TheComponentClass: TComponentClass; const ThePageName: string);
|
||||
begin
|
||||
inherited Create(TheComponentClass,ThePageName);
|
||||
FPkgFile:=ThePkgFile;
|
||||
FComponentClass:=TheComponentClass;
|
||||
if FComponentClass<>nil then
|
||||
FDefaultCompClassName:=FComponentClass.ClassName
|
||||
else
|
||||
FDefaultCompClassName:=TheDefCompClassName;
|
||||
end;
|
||||
|
||||
destructor TPkgComponent.Destroy;
|
||||
function TPkgComponent.GetUnitName: string;
|
||||
begin
|
||||
inherited Destroy;
|
||||
Result:=PkgFile.UnitName;
|
||||
end;
|
||||
|
||||
function TPkgComponent.GetComponentClassName: string;
|
||||
function TPkgComponent.GetPriority: integer;
|
||||
begin
|
||||
if ComponentClass<>nil then
|
||||
Result:=ComponentClass.ClassName
|
||||
else
|
||||
Result:=DefaultCompClassName;
|
||||
Result:=PkgFile.ComponentPriority;
|
||||
end;
|
||||
|
||||
procedure TPkgComponent.ConsistencyCheck;
|
||||
begin
|
||||
if (FComponentClass<>nil)
|
||||
and (AnsiCompareText(FComponentClass.ClassName,FDefaultCompClassName)<>0) then
|
||||
RaiseGDBException('TPkgComponent.ConsistencyCheck FComponentClass.ClassName<>FDefaultCompClassName');
|
||||
inherited ConsistencyCheck;
|
||||
if FPkgFile=nil then
|
||||
RaiseGDBException('TPkgComponent.ConsistencyCheck FPkgFile=nil');
|
||||
RaiseGDBException('TIDEComponent.ConsistencyCheck FPkgFile=nil');
|
||||
if FPkgFile.LazPackage=nil then
|
||||
RaiseGDBException('TPkgComponent.ConsistencyCheck FPkgFile.LazPackage=nil');
|
||||
RaiseGDBException('TIDEComponent.ConsistencyCheck FPkgFile.LazPackage=nil');
|
||||
if FPkgFile.LazPackage.IndexOfPkgComponent(Self)<0 then
|
||||
RaiseGDBException('TPkgComponent.ConsistencyCheck FPkgFile.LazPackage.IndexOfPkgComponent(Self)<0');
|
||||
if not IsValidIdent(FDefaultCompClassName) then
|
||||
RaiseGDBException('TPkgComponent.ConsistencyCheck not IsValidIdent(FDefaultCompClassName)');
|
||||
RaiseGDBException('TIDEComponent.ConsistencyCheck FPkgFile.LazPackage.IndexOfPkgComponent(Self)<0');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -39,13 +39,16 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, AVL_Tree, FileCtrl, Forms, Controls, Dialogs,
|
||||
LazarusIDEStrConsts, IDEProcs, PackageLinks, PackageDefs, LazarusPackageIntf;
|
||||
LazarusIDEStrConsts, IDEProcs, PackageLinks, PackageDefs, LazarusPackageIntf,
|
||||
ComponentReg, RegisterLCL, RegisterFCL;
|
||||
|
||||
type
|
||||
TLazPackageGraph = class
|
||||
private
|
||||
FAbortRegistration: boolean;
|
||||
FErrorMsg: string;
|
||||
FFCLPackage: TLazPackage;
|
||||
FLCLPackage: TLazPackage;
|
||||
FRegistrationFile: TPkgFile;
|
||||
FRegistrationPackage: TLazPackage;
|
||||
FRegistrationUnitName: string;
|
||||
@ -55,6 +58,8 @@ type
|
||||
procedure SetAbortRegistration(const AValue: boolean);
|
||||
procedure SetErrorMsg(const AValue: string);
|
||||
procedure SetRegistrationPackage(const AValue: TLazPackage);
|
||||
function CreateFCLPackage: TLazPackage;
|
||||
function CreateLCLPackage: TLazPackage;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -68,10 +73,14 @@ type
|
||||
IgnorePackage: TLazPackage): string;
|
||||
function NewPackage(const Prefix: string): TLazPackage;
|
||||
procedure ConsistencyCheck;
|
||||
procedure RegisterUnit(const TheUnitName: string;
|
||||
procedure RegisterUnitHandler(const TheUnitName: string;
|
||||
RegisterProc: TRegisterProc);
|
||||
procedure RegisterComponentsHandler(const Page: string;
|
||||
ComponentClasses: array of TComponentClass);
|
||||
procedure RegistrationError(const Msg: string);
|
||||
procedure RegisterPackage(APackage: TLazPackage);
|
||||
procedure AddPackage(APackage: TLazPackage);
|
||||
procedure AddStaticBasePackages;
|
||||
procedure RegisterStaticPackages;
|
||||
public
|
||||
property Packages[Index: integer]: TLazPackage read GetPackages;
|
||||
property RegistrationPackage: TLazPackage read FRegistrationPackage
|
||||
@ -81,6 +90,8 @@ type
|
||||
property ErrorMsg: string read FErrorMsg write SetErrorMsg;
|
||||
property AbortRegistration: boolean read FAbortRegistration
|
||||
write SetAbortRegistration;
|
||||
property FCLPackage: TLazPackage read FFCLPackage;
|
||||
property LCLPackage: TLazPackage read FLCLPackage;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -88,6 +99,18 @@ var
|
||||
|
||||
implementation
|
||||
|
||||
procedure RegisterComponentsGlobalHandler(const Page: string;
|
||||
ComponentClasses: array of TComponentClass);
|
||||
begin
|
||||
PackageGraph.RegisterComponentsHandler(Page,ComponentClasses);
|
||||
end;
|
||||
|
||||
procedure RegisterNoIconGlobalHandler(
|
||||
ComponentClasses: array of TComponentClass);
|
||||
begin
|
||||
PackageGraph.RegisterComponentsHandler('',ComponentClasses);
|
||||
end;
|
||||
|
||||
{ TLazPackageGraph }
|
||||
|
||||
function TLazPackageGraph.GetPackages(Index: integer): TLazPackage;
|
||||
@ -112,7 +135,9 @@ begin
|
||||
if FRegistrationPackage=AValue then exit;
|
||||
FRegistrationPackage:=AValue;
|
||||
AbortRegistration:=false;
|
||||
LazarusPackageIntf.RegisterUnit:=@RegisterUnit;
|
||||
LazarusPackageIntf.RegisterUnit:=@RegisterUnitHandler;
|
||||
RegisterComponentsProc:=@RegisterComponentsGlobalHandler;
|
||||
RegisterNoIconProc:=@RegisterNoIconGlobalHandler;
|
||||
end;
|
||||
|
||||
constructor TLazPackageGraph.Create;
|
||||
@ -123,8 +148,12 @@ end;
|
||||
|
||||
destructor TLazPackageGraph.Destroy;
|
||||
begin
|
||||
if LazarusPackageIntf.RegisterUnit=@RegisterUnit then
|
||||
if LazarusPackageIntf.RegisterUnit=@RegisterUnitHandler then
|
||||
LazarusPackageIntf.RegisterUnit:=nil;
|
||||
if RegisterComponentsProc=@RegisterComponentsGlobalHandler then
|
||||
RegisterComponentsProc:=nil;
|
||||
if RegisterNoIconProc=@RegisterNoIconGlobalHandler then
|
||||
RegisterNoIconProc:=nil;
|
||||
Clear;
|
||||
FItems.Free;
|
||||
FTree.Free;
|
||||
@ -216,7 +245,7 @@ begin
|
||||
CheckList(FItems,true,true,true);
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.RegisterUnit(const TheUnitName: string;
|
||||
procedure TLazPackageGraph.RegisterUnitHandler(const TheUnitName: string;
|
||||
RegisterProc: TRegisterProc);
|
||||
begin
|
||||
if AbortRegistration then exit;
|
||||
@ -237,6 +266,7 @@ begin
|
||||
RegistrationError('Invalid Unitname: '+FRegistrationUnitName);
|
||||
exit;
|
||||
end;
|
||||
// check unit file
|
||||
FRegistrationFile:=FRegistrationPackage.FindUnit(FRegistrationUnitName);
|
||||
if FRegistrationFile=nil then begin
|
||||
RegistrationError('Unit not found: '+FRegistrationUnitName);
|
||||
@ -262,6 +292,56 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.RegisterComponentsHandler(const Page: string;
|
||||
ComponentClasses: array of TComponentClass);
|
||||
var
|
||||
i: integer;
|
||||
CurComponent: TComponentClass;
|
||||
NewPkgComponent: TPkgComponent;
|
||||
CurClassname: string;
|
||||
begin
|
||||
if AbortRegistration or (Low(ComponentClasses)>High(ComponentClasses)) then
|
||||
exit;
|
||||
|
||||
ErrorMsg:='';
|
||||
|
||||
// check package
|
||||
if FRegistrationPackage=nil then begin
|
||||
RegistrationError('');
|
||||
exit;
|
||||
end;
|
||||
// check unit file
|
||||
if FRegistrationFile=nil then begin
|
||||
RegistrationError('Can not register components without unit');
|
||||
exit;
|
||||
end;
|
||||
// register components
|
||||
for i:=Low(ComponentClasses) to High(ComponentClasses) do begin
|
||||
CurComponent:=ComponentClasses[i];
|
||||
if (CurComponent=nil) then continue;
|
||||
try
|
||||
CurClassname:=CurComponent.Classname;
|
||||
if not IsValidIdent(CurClassname) then begin
|
||||
RegistrationError('Invalid component class');
|
||||
continue;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
RegistrationError(E.Message);
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
if IDEComponentPalette.FindComponent(CurClassname)<>nil then begin
|
||||
RegistrationError(
|
||||
'Component Class "'+CurComponent.ClassName+'" already defined');
|
||||
end;
|
||||
if AbortRegistration then exit;
|
||||
NewPkgComponent:=
|
||||
FRegistrationPackage.AddComponent(FRegistrationFile,Page,CurComponent);
|
||||
IDEComponentPalette.AddComponent(NewPkgComponent);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.RegistrationError(const Msg: string);
|
||||
var
|
||||
DlgResult: Integer;
|
||||
@ -290,10 +370,91 @@ begin
|
||||
AbortRegistration:=true;
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.RegisterPackage(APackage: TLazPackage);
|
||||
function TLazPackageGraph.CreateFCLPackage: TLazPackage;
|
||||
begin
|
||||
RegistrationPackage:=APackage;
|
||||
// ToDo
|
||||
Result:=TLazPackage.Create;
|
||||
with Result do begin
|
||||
AutoCreated:=true;
|
||||
Name:='FCL';
|
||||
Filename:='$(#FPCSrcDir)/fcl/';
|
||||
Version.SetValues(1,0,1,1);
|
||||
Author:='FPC team';
|
||||
AutoLoad:=true;
|
||||
AutoUpdate:=false;
|
||||
Description:='FCL - FreePascal Component Library';
|
||||
PackageType:=lptDesignTime;
|
||||
|
||||
// add files
|
||||
AddFile('inc/process.pp','Process',pftUnit,[pffHasRegisterProc],CompPriorityBase);
|
||||
AddFile('db/db.pp','DB',pftUnit,[pffHasRegisterProc],CompPriorityBase);
|
||||
|
||||
Modified:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.CreateLCLPackage: TLazPackage;
|
||||
begin
|
||||
Result:=TLazPackage.Create;
|
||||
with Result do begin
|
||||
AutoCreated:=true;
|
||||
Name:='LCL';
|
||||
Filename:='$(#LazarusDir)/lcl/';
|
||||
Version.SetValues(1,0,1,1);
|
||||
Author:='Lazarus';
|
||||
AutoLoad:=true;
|
||||
AutoUpdate:=false;
|
||||
Description:='LCL - Lazarus Component Library';
|
||||
PackageType:=lptDesignTime;
|
||||
|
||||
// add files
|
||||
AddFile('menus.pp','Menus',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('buttons.pp','Buttons',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('stdctrls.pp','StdCtrls',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('extctrls.pp','ExtCtrls',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('comctrls.pp','ComCtrls',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('forms.pp','Forms',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('grids.pas','Grids',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('controls.pp','Controls',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('dialogs.pp','Dialogs',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('spin.pp','Spin',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('arrow.pp','Arrow',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
AddFile('calendar.pp','Calendar',pftUnit,[pffHasRegisterProc],CompPriorityLCL);
|
||||
|
||||
// add requirements
|
||||
AddRequiredDependency(FCLPackage.CreateDependencyForThisPkg);
|
||||
|
||||
Modified:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.AddPackage(APackage: TLazPackage);
|
||||
begin
|
||||
FTree.Add(APackage);
|
||||
FItems.Add(APackage);
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.AddStaticBasePackages;
|
||||
begin
|
||||
// FCL
|
||||
FFCLPackage:=CreateFCLPackage;
|
||||
AddPackage(FFCLPackage);
|
||||
// LCL
|
||||
FLCLPackage:=CreateLCLPackage;
|
||||
AddPackage(FLCLPackage);
|
||||
end;
|
||||
|
||||
procedure TLazPackageGraph.RegisterStaticPackages;
|
||||
begin
|
||||
// FCL
|
||||
RegistrationPackage:=FCLPackage;
|
||||
RegisterFCL.Register;
|
||||
|
||||
// LCL
|
||||
RegistrationPackage:=LCLPackage;
|
||||
RegisterLCL.Register;
|
||||
|
||||
// clean up
|
||||
RegistrationPackage:=nil;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -46,6 +46,7 @@ uses
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, LCLProc, Forms, COntrols, KeyMapping, EnvironmentOpts,
|
||||
UComponentManMain, PackageEditor, PackageDefs, PackageLinks, PackageSystem,
|
||||
ComponentReg,
|
||||
BasePkgManager, MainBar;
|
||||
|
||||
type
|
||||
@ -59,6 +60,8 @@ type
|
||||
procedure ConnectSourceNotebookEvents; override;
|
||||
procedure SetupMainBarShortCuts; override;
|
||||
|
||||
procedure LoadInstalledPackages; override;
|
||||
|
||||
function ShowConfigureCustomComponents: TModalResult; override;
|
||||
function DoNewPackage: TModalResult; override;
|
||||
end;
|
||||
@ -75,6 +78,7 @@ end;
|
||||
constructor TPkgManager.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
IDEComponentPalette:=TIDEComponentPalette.Create;
|
||||
PackageGraph:=TLazPackageGraph.Create;
|
||||
PackageEditors:=TPackageEditors.Create;
|
||||
end;
|
||||
@ -83,6 +87,7 @@ destructor TPkgManager.Destroy;
|
||||
begin
|
||||
FreeThenNil(PackageEditors);
|
||||
FreeThenNil(PackageGraph);
|
||||
FreeThenNil(IDEComponentPalette);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -103,6 +108,15 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TPkgManager.LoadInstalledPackages;
|
||||
begin
|
||||
// base packages
|
||||
PackageGraph.AddStaticBasePackages;
|
||||
PackageGraph.RegisterStaticPackages;
|
||||
// custom packages
|
||||
// ToDo
|
||||
end;
|
||||
|
||||
function TPkgManager.ShowConfigureCustomComponents: TModalResult;
|
||||
begin
|
||||
Result:=ShowConfigureCustomComponentDlg(EnvironmentOptions.LazarusDirectory);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user