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

implemented custom package initialization

Browse Source 
git-svn-id: trunk@4096 -
This commit is contained in:
mattias 2003-04-26 07:34:55 +00:00
parent ac2eaea0ba
commit fa9c84c773
13 changed files with 183 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/codetools/codetoolsstrconsts.pas
View File

@ -162,6 +162,7 @@ ResourceString
'Source filenames for the standard fpc units';
ctsFreePascalSourceDir = 'Free Pascal Source Directory';
ctsSrcPathInitialization = 'SrcPath Initialization';
ctsUnitPathInitialization = 'UnitPath Initialization';
ctsNestedCommentsOn = 'Nested Comments On';
ctsCompiler = 'Compiler';
ctsDefineProzessorType = 'Define processor type';

3
components/codetools/definetemplates.pas
View File

@ -2872,6 +2872,9 @@ begin
DefTempl:=TDefineTemplate.Create('Reset SrcPath',
ctsSrcPathInitialization,ExternalMacroStart+'SrcPath','',da_DefineRecurse);
MainDir.AddChild(DefTempl);
DefTempl:=TDefineTemplate.Create('Reset UnitPath',
ctsSrcPathInitialization,ExternalMacroStart+'UnitPath','',da_DefineRecurse);
MainDir.AddChild(DefTempl);
// turn Nested comments on
DefTempl:=TDefineTemplate.Create('Nested Comments',
ctsNestedCommentsOn,ExternalMacroStart+'NestedComments','',da_DefineRecurse);

10
components/codetools/finddeclarationtool.pas
View File

@ -1229,8 +1229,16 @@ begin
exit;
if Assigned(OnGetUnitSourceSearchPath) then
UnitSrcSearchPath:=OnGetUnitSourceSearchPath(Self)
else
else begin
UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath'];
UnitSrcSearchPath:=Scanner.Values[ExternalMacroStart+'SrcPath'];
if UnitSearchPath<>'' then begin
if UnitSrcSearchPath<>'' then
UnitSrcSearchPath:=UnitSrcSearchPath+';'+UnitSearchPath
else
UnitSrcSearchPath:=UnitSearchPath;
end;
end;
{$IFDEF ShowSearchPaths}
writeln('TFindDeclarationTool.FindUnitSource ',
' Self="',MainFilename,'"',

19
ide/environmentopts.pp
View File

@ -208,6 +208,9 @@ type
fPascalFileAskLowerCase: boolean;
fAmbigiousFileAction: TAmbigiousFileAction;
// auto install packages
fAutoInstallPackages: TStringList;
// language
fLanguage: TLazarusLanguage;
@ -359,6 +362,9 @@ type
// language
property Language: TLazarusLanguage read fLanguage write fLanguage;
// auto install packages
property AutoInstallPackages: TStringList read fAutoInstallPackages;
end;
//----------------------------------------------------------------------------
@ -706,13 +712,18 @@ begin
// external tools
fExternalTools:=TExternalToolList.Create;
// naming
fPascalFileExtension:=petPAS;
fPascalFileAutoLowerCase:=false;
fPascalFileAskLowerCase:=true;
// auto install packages
fAutoInstallPackages:=TStringList.Create;
end;
destructor TEnvironmentOptions.Destroy;
begin
fAutoInstallPackages.Free;
fExternalTools.Free;
FRecentOpenFiles.Free;
FRecentProjectFiles.Free;
@ -940,6 +951,10 @@ begin
,'EnvironmentOptions/BackupProjectFiles/');
LoadBackupInfo(FBackupInfoOtherFiles
,'EnvironmentOptions/BackupOtherFiles/');
// auto install packages
LoadStringList(XMLConfig,fAutoInstallPackages,
'EnvironmentOptions/AutoInstallPackages/');
end;
// hints
@ -1123,6 +1138,10 @@ begin
,'EnvironmentOptions/BackupProjectFiles/');
SaveBackupInfo(FBackupInfoOtherFiles
,'EnvironmentOptions/BackupOtherFiles/');
// auto install packages
SaveStringList(XMLConfig,fAutoInstallPackages,
'EnvironmentOptions/AutoInstallPackages/');
end;
// hints

19
ide/lazarus.pp
View File

@ -51,14 +51,15 @@ uses
Forms,
Splash,
Main,
MainBar,
MsgView,
FindReplaceDialog,
FindInFilesDlg;
// use the custom IDE static packages AFTER 'main'
{$IFDEF AddStaticPkgs}
{$I staticpackages.inc}
{$ENDIF}
MainBar;
begin
Application.Initialize;
TMainIde.ParseCmdLineOptions;
TMainIDE.ParseCmdLineOptions;
// Show splashform
SplashForm := TSplashForm.Create(nil);
@ -69,14 +70,11 @@ begin
Application.ProcessMessages; // process splash paint message
Application.CreateForm(TMainIDE, MainIDE);
MainIDE.CreateOftenUsedForms;
{$IFDEF IDE_MEM_CHECK}
CheckHeapWrtMemCnt('lazarus.pp: TMainIDE created');
{$ENDIF}
Application.CreateForm(TMessagesView, MessagesView);
Application.CreateForm(TLazFindReplaceDialog, FindReplaceDlg);
Application.CreateForm(TLazFindInFilesDialog, FindInFilesDialog);
SplashForm.StartTimer;
Application.Run;
SplashForm.Free;
@ -92,6 +90,9 @@ end.
{
$Log$
Revision 1.43 2003/04/26 07:34:54 mattias
implemented custom package initialization
Revision 1.42 2003/04/21 16:21:28 mattias
implemented default package for custom IDE components

2
ide/mainbar.pas
View File

@ -348,6 +348,8 @@ type
CurrentParsedCompilerOption: TParsedCompilerOptions;
MacroList: TTransferMacroList;
procedure CreateOftenUsedForms; virtual; abstract;
function FindUnitFile(const AFilename: string): string; virtual; abstract;
procedure GetCurrentUnit(var ActiveSourceEditor:TSourceEditor;
var ActiveUnitInfo:TUnitInfo); virtual; abstract;

5
ide/msgview.pp
View File

@ -70,8 +70,8 @@ type
property OnSelectionChanged : TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
end;
const
MessagesView : TMessagesView = nil;
var
MessagesView: TMessagesView;
implementation
@ -220,6 +220,7 @@ begin
end;
initialization
MessagesView:=nil;
{ $I msgview.lrs}

10
ide/unitinfodlg.pp
View File

@ -27,7 +27,7 @@ unit UnitInfoDlg;
interface
uses
Classes, SysUtils, Controls, StdCtrls, Forms, Buttons, ExtCtrls;
Classes, SysUtils, Controls, StdCtrls, Forms, Buttons, ExtCtrls, IDEProcs;
type
TUnitInfoDlg = class(TFORM)
@ -59,7 +59,9 @@ type
procedure OkButtonClick(Sender:TObject);
procedure clearIncludedByClick(Sender: TObject);
private
FFilePath: string;
function getIncludedBy: string;
procedure setFilePath(const AFilePath: string);
procedure setShortName(const str:string);
procedure setType(const str:string);
procedure setInProject(const str:string);
@ -95,6 +97,7 @@ begin
Dlg:=TUnitInfoDlg.Create(Application);
with Dlg do begin
Caption:='Information about '+AnUnitName;
setFilePath(FilePath);
setShortName(AnUnitName);
setType(AType);
if IsPartOfProject then
@ -556,5 +559,10 @@ begin
Result:=outIncludedBy.Caption;
end;
procedure TUnitInfoDlg.setFilePath(const AFilePath: string);
begin
FFilePath:=AFilePath;
end;
end.

52
packager/packagedefs.pas
View File

@ -439,6 +439,7 @@ type
FLicense: string;
FMacros: TTransferMacroList;
FModifiedLock: integer;
FOutputStateFile: string;
FPackageEditor: TBasePackageEditor;
FPackageType: TLazPackageType;
FReadOnly: boolean;
@ -468,6 +469,7 @@ type
procedure SetIconFile(const AValue: string);
procedure SetInstalled(const AValue: TPackageInstallType);
procedure SetLicense(const AValue: string);
procedure SetOutputStateFile(const AValue: string);
procedure SetRegistered(const AValue: boolean);
procedure SetModified(const AValue: boolean);
procedure SetName(const AValue: string); override;
@ -582,6 +584,7 @@ type
property License: string read FLicense write SetLicense;
property Macros: TTransferMacroList read FMacros;
property Modified: boolean read GetModified write SetModified;
property OutputStateFile: string read FOutputStateFile write SetOutputStateFile;
property PackageType: TLazPackageType read FPackageType
write SetPackageType;
property ReadOnly: boolean read FReadOnly write SetReadOnly;
@ -1433,8 +1436,11 @@ end;
function TPkgVersion.AsString: string;
begin
Result:=IntToStr(Major)+'.'+IntToStr(Minor)+'.'+IntToStr(Release)
+'.'+IntToStr(Build);
Result:=IntToStr(Major)+'.'+IntToStr(Minor);
if (Build<>0) then
Result:=Result+'.'+IntToStr(Release)+'.'+IntToStr(Build)
else if (Release<>0) then
Result:=Result+'.'+IntToStr(Release)
end;
function TPkgVersion.ReadString(const s: string): boolean;
@ -1447,22 +1453,24 @@ begin
Result:=false;
CurPos:=1;
for i:=Low(ints) to High(ints) do begin
// read int
StartPos:=CurPos;
ints[i]:=0;
while (CurPos<=length(s)) and (s[CurPos] in ['0'..'9']) do begin
ints[i]:=ints[i]*10+ord(s[CurPos])-ord('0');
inc(CurPos);
end;
if (StartPos=CurPos) then exit;
// read point
if (CurPos>length(s)) then begin
if i<High(ints) then exit;
end else begin
if s[CurPos]<>'.' then exit;
inc(CurPos);
if CurPos<length(s) then begin
if i>Low(ints) then begin
// read point
if s[CurPos]<>'.' then exit;
inc(CurPos);
end;
// read int
StartPos:=CurPos;
while (CurPos<=length(s)) and (i<=9999)
and (s[CurPos] in ['0'..'9']) do begin
ints[i]:=ints[i]*10+ord(s[CurPos])-ord('0');
inc(CurPos);
end;
if (StartPos=CurPos) then exit;
end;
end;
if CurPos<=length(s) then exit;
SetValues(ints[1],ints[2],ints[3],ints[4]);
Result:=true;
@ -1655,6 +1663,12 @@ begin
Modified:=true;
end;
procedure TLazPackage.SetOutputStateFile(const AValue: string);
begin
if FOutputStateFile=AValue then exit;
FOutputStateFile:=AValue;
end;
procedure TLazPackage.SetRegistered(const AValue: boolean);
begin
if FRegistered=AValue then exit;
@ -1879,6 +1893,7 @@ begin
LoadFlags(Path);
FIconFile:=XMLConfig.GetValue(Path+'IconFile/Value','');
FName:=XMLConfig.GetValue(Path+'Name/Value','');
OutputStateFile:=XMLConfig.GetValue(Path+'OutputStateFile/Value','');
FPackageType:=LazPackageTypeIdentToType(XMLConfig.GetValue(Path+'Type/Value',
LazPackageTypeIdents[lptRunTime]));
LoadPkgDependencyList(XMLConfig,Path+'RequiredPkgs/',
@ -1923,6 +1938,7 @@ begin
SaveFlags(Path);
XMLConfig.SetDeleteValue(Path+'IconFile/Value',FIconFile,'');
XMLConfig.SetDeleteValue(Path+'Name/Value',FName,'');
XMLConfig.SetDeleteValue(Path+'OutputStateFile/Value',OutputStateFile,'');
XMLConfig.SetDeleteValue(Path+'Type/Value',LazPackageTypeIdents[FPackageType],
LazPackageTypeIdents[lptRunTime]);
SavePkgDependencyList(XMLConfig,Path+'RequiredPkgs/',
@ -2413,7 +2429,11 @@ end;
procedure TLazPackageID.UpdateIDAsString;
begin
FIDAsString:=Name+' '+Version.AsString;
FIDAsString:=Version.AsString;
if FIDAsString<>'' then
FIDAsString:=Name+' '+FIDAsString
else
FIDAsString:=FIDAsString;
end;
procedure TLazPackageID.VersionChanged(Sender: TObject);

2
packager/packagelinks.pas
View File

@ -77,7 +77,7 @@ type
TPackageLinks = class
private
FGlobalLinks: TAVLTree; // tree of TPackageLink
FGlobalLinks: TAVLTree; // tree of TPackageLink sorted for ID
FModified: boolean;
FUserLinks: TAVLTree; // tree of TPackageLink
fUpdateLock: integer;

28
packager/packagesystem.pas
View File

@ -272,7 +272,7 @@ begin
if FRegistrationPackage=AValue then exit;
FRegistrationPackage:=AValue;
AbortRegistration:=false;
LazarusPackageIntf.RegisterUnit:=@RegisterUnitHandler;
LazarusPackageIntf.RegisterUnitProc:=@RegisterUnitHandler;
RegisterComponentsProc:=@RegisterComponentsGlobalHandler;
RegisterNoIconProc:=@RegisterNoIconGlobalHandler;
end;
@ -338,8 +338,8 @@ end;
destructor TLazPackageGraph.Destroy;
begin
if LazarusPackageIntf.RegisterUnit=@RegisterUnitHandler then
LazarusPackageIntf.RegisterUnit:=nil;
if LazarusPackageIntf.RegisterUnitProc=@RegisterUnitHandler then
LazarusPackageIntf.RegisterUnitProc:=nil;
if RegisterComponentsProc=@RegisterComponentsGlobalHandler then
RegisterComponentsProc:=nil;
if RegisterNoIconProc=@RegisterNoIconGlobalHandler then
@ -806,7 +806,7 @@ begin
AutoCreated:=true;
Name:='FCL';
Filename:='$(FPCSrcDir)/fcl/';
Version.SetValues(1,0,1,1);
Version.SetValues(1,0,0,0);
Author:='FPC team';
License:='LGPL-2';
AutoInstall:=pitStatic;
@ -837,7 +837,7 @@ begin
AutoCreated:=true;
Name:='LCL';
Filename:='$(LazarusDir)/lcl/';
Version.SetValues(1,0,1,1);
Version.SetValues(1,0,0,0);
Author:='Lazarus';
License:='LGPL-2';
AutoInstall:=pitStatic;
@ -848,6 +848,9 @@ begin
Installed:=pitStatic;
CompilerOptions.UnitOutputDirectory:='';
// add requirements
AddRequiredDependency(FCLPackage.CreateDependencyForThisPkg);
// add registering units
AddFile('menus.pp','Menus',pftUnit,[pffHasRegisterProc],cpBase);
AddFile('buttons.pp','Buttons',pftUnit,[pffHasRegisterProc],cpBase);
@ -870,10 +873,11 @@ begin
// add unit paths
UsageOptions.UnitPath:=
'$(LazarusDir)/lcl/units;$(LazarusDir)/lcl/units/$(LCLWidgetType)';
// use the lcl/units/allunits.o file as indicator,
// if LCL has been recompiled
OutputStateFile:='$(LazarusDir)/lcl/units/allunits.o';
// add requirements
AddRequiredDependency(FCLPackage.CreateDependencyForThisPkg);
Modified:=false;
end;
end;
@ -896,6 +900,9 @@ begin
Installed:=pitStatic;
CompilerOptions.UnitOutputDirectory:='';
// add requirements
AddRequiredDependency(LCLPackage.CreateDependencyForThisPkg);
// add units
AddFile('synedit.pp','SynEdit',pftUnit,[],cpBase);
AddFile('syneditlazdsgn.pas','SynEditLazDsgn',pftUnit,[],cpBase);
@ -915,8 +922,9 @@ begin
// add unit paths
UsageOptions.UnitPath:='$(LazarusDir)/components/units';
// add requirements
AddRequiredDependency(LCLPackage.CreateDependencyForThisPkg);
// use the lcl/units/allunits.o file as indicator,
// if synedit has been recompiled
OutputStateFile:='$(LazarusDir)/components/units/allunits.o';
Modified:=false;
end;

15
packager/pkgmanager.pas
View File

@ -770,6 +770,7 @@ var
CurFile: TPkgFile;
Dependency: TPkgDependency;
RequiredPackage: TLazPackage;
OtherStateFile: String;
begin
Result:=mrYes;
writeln('TPkgManager.CheckIfPackageNeedsCompilation A ',APackage.IDAsString);
@ -799,6 +800,7 @@ begin
while Dependency<>nil do begin
if (Dependency.LoadPackageResult=lprSuccess) then begin
RequiredPackage:=Dependency.RequiredPackage;
// check compile state file of required package
if not RequiredPackage.AutoCreated then begin
Result:=DoLoadPackageCompiledState(RequiredPackage,false);
if Result<>mrOk then exit;
@ -814,6 +816,14 @@ begin
exit;
end;
end;
// check output state file of required package
if RequiredPackage.OutputStateFile<>'' then begin
OtherStateFile:=RequiredPackage.OutputStateFile;
MainIDE.MacroList.SubstituteStr(OtherStateFile);
if FileExists(OtherStateFile)
and (FileAge(OtherStateFile)>StateFileAge) then
exit;
end;
end;
Dependency:=Dependency.NextRequiresDependency;
end;
@ -1679,8 +1689,6 @@ begin
+'uses'+e
+' '+UsedUnits+', LazarusPackageIntf;'+e
+e
+'procedure Register;'+e
+e
+'implementation'+e
+e
+'procedure Register;'+e
@ -1688,6 +1696,9 @@ begin
+RegistrationCode
+'end;'+e
+e
+'initialization'
+' RegisterPackage('''+APackage.Name+''',@Register)'
+e
+'end.'+e;
Src:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.
BeautifyStatement(Src,0);

63
packager/registration/lazaruspackageintf.pas
View File

@ -29,7 +29,7 @@
Author: Mattias Gaertner
Abstract:
API for packages and registration of units.
API for packages and registration of units and packages.
}
unit LazarusPackageIntf;
@ -45,14 +45,69 @@ type
TRegisterUnitProc = procedure(const TheUnitName: string;
RegisterProc: TRegisterProc) of object;
var
RegisterUnit: TRegisterUnitProc;
RegisterUnitProc: TRegisterUnitProc;
procedure RegisterUnit(const TheUnitName: string; RegisterProc: TRegisterProc);
procedure RegisterPackage(const ThePackageName: string;
RegisterProc: TRegisterProc);
implementation
type
TRegisteredPackage = record
Name: string;
RegisterProc: TRegisterProc;
end;
PRegisteredPackage = ^TRegisteredPackage;
var
RegisteredPackages: TList;
procedure RegisterUnit(const TheUnitName: string; RegisterProc: TRegisterProc);
begin
RegisterUnitProc(TheUnitName,RegisterProc);
end;
procedure RegisterPackage(const ThePackageName: string;
RegisterProc: TRegisterProc);
var
NewRegisteredPackage: PRegisteredPackage;
begin
if RegisteredPackages=nil then RegisteredPackages:=TList.Create;
New(NewRegisteredPackage);
NewRegisteredPackage^.Name:=ThePackageName;
NewRegisteredPackage^.RegisterProc:=RegisterProc;
RegisteredPackages.Add(NewRegisteredPackage);
end;
procedure InternalInit;
begin
RegisterUnitProc:=nil;
RegisteredPackages:=nil;
end;
procedure InternalFinal;
var
RegisteredPackage: PRegisteredPackage;
i: Integer;
begin
if RegisteredPackages<>nil then begin
for i:=0 to RegisteredPackages.Count-1 do begin
RegisteredPackage:=PRegisteredPackage(RegisteredPackages[i]);
Dispose(RegisteredPackage);
end;
RegisteredPackages.Free;
RegisteredPackages:=nil;
end;
end;
initialization
RegisterUnit:=nil;
InternalInit;
finalization
InternalFinal;
end.