mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-02 19:47:02 +01:00
projectgroups: initial implementation from Michael Van Canneyt
git-svn-id: trunk@50076 -
This commit is contained in:
mattias
parent
cfb5aea1e9
commit
26a2c4b07b
8
.gitattributes
vendored
8
.gitattributes
vendored
@ -3348,6 +3348,14 @@ components/printers/win32/winprinters_h.inc svneol=native#text/pascal
|
||||
components/printers/win32/winprndialogs.inc svneol=native#text/pascal
|
||||
components/printers/win32/winutilprn.pas svneol=native#text/pascal
|
||||
components/printers/win32/winutilprnconst.inc svneol=native#text/pascal
|
||||
components/projectgroups/README.txt svneol=native#text/plain
|
||||
components/projectgroups/lazprojectgroup.pas svneol=native#text/plain
|
||||
components/projectgroups/lazprojectgroups.lpk svneol=native#text/plain
|
||||
components/projectgroups/projectgroup.pp svneol=native#text/plain
|
||||
components/projectgroups/projectgroupeditor.lfm svneol=native#text/plain
|
||||
components/projectgroups/projectgroupeditor.pas svneol=native#text/plain
|
||||
components/projectgroups/projectgroupintf.pp svneol=native#text/plain
|
||||
components/projectgroups/regprojectgroup.pp svneol=native#text/plain
|
||||
components/projecttemplates/Makefile svneol=native#text/plain
|
||||
components/projecttemplates/Makefile.compiled svneol=native#text/plain
|
||||
components/projecttemplates/Makefile.fpc svneol=native#text/plain
|
||||
|
||||
7
components/projectgroups/README.txt
Normal file
7
components/projectgroups/README.txt
Normal file
@ -0,0 +1,7 @@
|
||||
IDE add-on for Project Groups.
|
||||
Project Groups allows to build groups of projects with a few mouse clicks.
|
||||
|
||||
UNDER CONSTRUCTION by Mattias Gaertner
|
||||
|
||||
Original code from Michael Van Canneyt.
|
||||
|
||||
22
components/projectgroups/lazprojectgroup.pas
Normal file
22
components/projectgroups/lazprojectgroup.pas
Normal file
@ -0,0 +1,22 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit lazprojectgroup;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
projectgroupintf, projectgroup, projectgroupeditor, regprojectgroup,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('regprojectgroup', @regprojectgroup.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('lazprojectgroup', @Register);
|
||||
end.
|
||||
52
components/projectgroups/lazprojectgroups.lpk
Normal file
52
components/projectgroups/lazprojectgroups.lpk
Normal file
@ -0,0 +1,52 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="lazprojectgroups"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<Author Value="Michael Van Canneyt"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="IDE Add-on for grouping projects, packages and project groups."/>
|
||||
<License Value="Same as IDEIntf.
|
||||
Modified LGPL-2."/>
|
||||
<Version Minor="1"/>
|
||||
<Files Count="5">
|
||||
<Item1>
|
||||
<Filename Value="projectgroupintf.pp"/>
|
||||
<UnitName Value="projectgroupintf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="projectgroup.pp"/>
|
||||
<UnitName Value="projectgroup"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="projectgroupeditor.pas"/>
|
||||
<UnitName Value="projectgroupeditor"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="regprojectgroup.pp"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="regprojectgroup"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="README.txt"/>
|
||||
<Type Value="Binary"/>
|
||||
</Item5>
|
||||
</Files>
|
||||
<RequiredPkgs Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
678
components/projectgroups/projectgroup.pp
Normal file
678
components/projectgroups/projectgroup.pp
Normal file
@ -0,0 +1,678 @@
|
||||
unit ProjectGroup;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, contnrs,
|
||||
Laz2_XMLCfg,
|
||||
Controls, Forms, Dialogs, LazFileUtils, LazFileCache,
|
||||
ProjectGroupIntf, PackageIntf, ProjectIntf, MenuIntf,
|
||||
LazIDEIntf, IDEDialogs, CompOptsIntf;
|
||||
|
||||
|
||||
Type
|
||||
|
||||
{ TIDECompileTarget }
|
||||
|
||||
TIDECompileTarget = class(TCompileTarget)
|
||||
private
|
||||
FTarget : TPersistent;
|
||||
protected
|
||||
Procedure LoadPackage;
|
||||
Procedure LoadProject;
|
||||
Procedure LoadProjectGroup;
|
||||
Function ProjectAction(AAction : TTargetAction) : TActionResult;
|
||||
Function PackageAction(AAction : TTargetAction) : TActionResult;
|
||||
Function ProjectGroupAction(AAction : TTargetAction) : TActionResult;
|
||||
function GetIDEPackage: TIDEPackage; override;
|
||||
function GetLazProject: TLazProject; override;
|
||||
function GetProjectGroup: TProjectGroup; override;
|
||||
function PerformAction(AAction: TTargetAction): TActionResult; override;
|
||||
public
|
||||
Procedure LoadTarget;
|
||||
Procedure UnLoadTarget;
|
||||
end;
|
||||
|
||||
// Since a project group iself is also a target, we need a target to represent
|
||||
// the root projectgroup.
|
||||
|
||||
{ TProjectGroupTarget }
|
||||
|
||||
TProjectGroupTarget = Class(TIDECompileTarget)
|
||||
protected
|
||||
procedure SetTargetType(AValue: TTargetType); override;
|
||||
Public
|
||||
Constructor Create(AProjectGroup : TProjectGroup);
|
||||
end;
|
||||
|
||||
TTargetEvent = Procedure(Sender : TObject; Target : TCompileTarget) of object;
|
||||
TTargetExchangeEvent = Procedure(Sender : TObject; Target1,Target2 : TCompileTarget) of object;
|
||||
|
||||
{ TIDEProjectGroup }
|
||||
|
||||
TIDEProjectGroup = Class(TProjectGroup)
|
||||
Private
|
||||
FOnFileNameChange: TNotifyEvent;
|
||||
FOnTargetActivated: TTargetEvent;
|
||||
FOnTargetAdded: TTargetEvent;
|
||||
FOnTargetDeleted: TTargetEvent;
|
||||
FOnTargetsExchanged: TTargetExchangeEvent;
|
||||
FTargets : TFPObjectList;
|
||||
FModified : Boolean;
|
||||
protected
|
||||
procedure SetFileName(AValue: String); override;
|
||||
function GetModified: Boolean; override;
|
||||
function GetTarget(AIndex: Integer): TCompileTarget; override;
|
||||
function GetTargetCount: Integer; override;
|
||||
Public
|
||||
Constructor Create;
|
||||
Function AddTarget(Const AFileName: String): TCompileTarget; override;
|
||||
Procedure RemoveTarget(T : TCompileTarget) ; override;
|
||||
Procedure ExchangeTargets(ASource, ATarget: Integer); override;
|
||||
Procedure ActivateTarget(T : TCompileTarget); override;
|
||||
Function LoadFromFile(Options : TProjectGroupLoadOptions ) : Boolean;
|
||||
Function SaveToFile : Boolean;
|
||||
Property OnFileNameChange : TNotifyEvent Read FOnFileNameChange Write FOnFileNameChange;
|
||||
Property OnTargetAdded : TTargetEvent Read FOnTargetAdded Write FOnTargetAdded;
|
||||
Property OnTargetDeleted : TTargetEvent Read FOnTargetDeleted Write FOnTargetDeleted;
|
||||
Property OnTargetActivated : TTargetEvent Read FOnTargetActivated Write FOnTargetActivated;
|
||||
Property OnTargetsExchanged : TTargetExchangeEvent Read FOnTargetsExchanged Write FOnTargetsExchanged;
|
||||
end;
|
||||
|
||||
{ TIDEProjectGroupManager }
|
||||
|
||||
TIDEProjectGroupManager = Class(TProjectGroupManager)
|
||||
private
|
||||
Function GetNewFileName: Boolean;
|
||||
Protected
|
||||
FProjectGroup : TIDEProjectGroup;
|
||||
protected
|
||||
Function CheckSaved : Boolean;
|
||||
function GetCurrentProjectGroup: TProjectGroup; override;
|
||||
Function ShowProjectGroupEditor : Boolean;
|
||||
public
|
||||
// Events for main menu
|
||||
Procedure DoNewClick(Sender : TObject); virtual;
|
||||
Procedure DoOpenClick(Sender : TObject); virtual;
|
||||
Procedure DoSaveClick(Sender : TObject); virtual;
|
||||
Procedure DoSaveAsClick(Sender : TObject); virtual;
|
||||
// Public interface
|
||||
Procedure LoadProjectGroup(AFileName: string; AOptions: TProjectGroupLoadOptions); override;
|
||||
Procedure SaveProjectGroup; override;
|
||||
end;
|
||||
|
||||
TEditProjectGroupOption = (epgoReusewindow);
|
||||
TEditProjectGroupOptions = Set of TEditProjectGroupOption;
|
||||
|
||||
TEditProjectGroupHandler = Procedure(AProjectGroup : TProjectGroup; Options : TEditProjectGroupOptions);
|
||||
// Method variant.
|
||||
TEditProjectGroupEvent = Procedure(AProjectGroup : TProjectGroup; Options : TEditProjectGroupOptions) of object;
|
||||
|
||||
Var
|
||||
OnEditProjectGroup : TEditProjectGroupHandler; // Takes precedence
|
||||
OnEditProjectGroupEvent : TEditProjectGroupEvent;
|
||||
|
||||
IDEProjectGroupManager : TIDEProjectGroupManager;
|
||||
// Project group editor(s). Should probably move to MenuIntf
|
||||
ProjectGroupMenuRoot: TIDEMenuSection = nil;
|
||||
PGEditMenuSectionFiles, // e.g. sort files, clean up files
|
||||
PGEditMenuSectionAddRemove, // e.g. add unit, add dependency
|
||||
PGEditMenuSectionCompile, // e.g. build clean, create Makefile
|
||||
PGEditMenuSectionUse, // Target up/down
|
||||
PGEditMenuSectionMisc: TIDEMenuSection; // e.g. options
|
||||
|
||||
Var
|
||||
cmdOpenProjectGroup,
|
||||
cmdSaveProjectGroup,
|
||||
cmdCreateProjectGroup,
|
||||
cmdSaveProjectGroupAs,
|
||||
|
||||
cmdTargetAdd,
|
||||
cmdTargetRemove,
|
||||
cmdTargetEarlier,
|
||||
cmdTargetActivate,
|
||||
cmdTargetLater,
|
||||
cmdTargetCompile,
|
||||
cmdTargetCompileClean,
|
||||
cmdTargetInstall,
|
||||
cmdTargetOpen,
|
||||
cmdTargetRun,
|
||||
cmdTargetProperties,
|
||||
cmdTargetUninstall: TIDEMenuCommand;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Resourcestring
|
||||
lisErrTargetDoesNotExist = 'Target does not exist. Remove ?';
|
||||
lisErrNoSuchFile = 'Could not find target file'+sLineBreak+
|
||||
'"%s"'+sLineBreak+
|
||||
'What do you want to do ?';
|
||||
lisRemoveTarget = 'Remove target';
|
||||
lisAbortLoadingProjectGroup = 'Abort loading project group';
|
||||
lisSkipAllTargets = 'Remove all invalid targets';
|
||||
lisErrOnlyProjectGroupAllowed = 'Only target type "projectgroup" is allowed for root project group';
|
||||
lisProjectGroupModified = 'Project group modified';
|
||||
lisProjectGroupModifiedConfirm = 'Project group "%s" is modified.'+sLineBreak+
|
||||
'what do you want to do?';
|
||||
|
||||
lisSavePG = 'Save project group';
|
||||
lisDiscard = 'Discard changes';
|
||||
lisAbort = 'Abort';
|
||||
|
||||
|
||||
{ TIDEProjectGroupManager }
|
||||
|
||||
Function TIDEProjectGroupManager.CheckSaved: Boolean;
|
||||
begin
|
||||
Result:=Not Assigned(FProjectGroup);
|
||||
if Not Result then
|
||||
begin
|
||||
Result:=Not FProjectGroup.Modified;
|
||||
If Not Result then
|
||||
// For some reason, only 2 buttons are shown ???
|
||||
Case IDEQuestionDialog(lisProjectGroupModified,
|
||||
Format(lisProjectGroupModifiedConfirm,[FProjectGroup.FileName]),
|
||||
mtWarning,
|
||||
[mrYes,lisSavePG,
|
||||
mrNo,lisDiscard,
|
||||
mrAbort,lisAbort],'') of
|
||||
mrYes :
|
||||
begin
|
||||
SaveProjectGroup;
|
||||
Result:=true;
|
||||
end;
|
||||
mrNo :
|
||||
begin
|
||||
FProjectGroup.FModified:=False;
|
||||
Result:=True;
|
||||
end
|
||||
else
|
||||
Result:=False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIDEProjectGroupManager.GetCurrentProjectGroup: TProjectGroup;
|
||||
begin
|
||||
Result:=FProjectGroup;
|
||||
end;
|
||||
|
||||
Function TIDEProjectGroupManager.ShowProjectGroupEditor : Boolean;
|
||||
|
||||
begin
|
||||
Result:=Assigned(FProjectGroup);
|
||||
if Result then
|
||||
begin
|
||||
if Assigned(OnEditProjectGroup) then
|
||||
OnEditProjectGroup(FProjectGroup,[])
|
||||
else if Assigned(OnEditProjectGroupEvent) then
|
||||
OnEditProjectGroupEvent(FProjectGroup,[])
|
||||
Else
|
||||
Result:=False;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroupManager.DoNewClick(Sender: TObject);
|
||||
begin
|
||||
if Not CheckSaved then
|
||||
Exit;
|
||||
FreeAndNil(FProjectGroup);
|
||||
FProjectGroup:=TIDEProjectGroup.Create;
|
||||
ShowProjectGroupEditor;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroupManager.DoOpenClick(Sender: TObject);
|
||||
|
||||
Var
|
||||
F : TOpenDialog;
|
||||
begin
|
||||
if Not CheckSaved then
|
||||
Exit;
|
||||
F:=TOpenDialog.Create(Nil);
|
||||
With F do
|
||||
try
|
||||
InitIDEFileDialog(F);
|
||||
F.Options:=[ofFileMustExist,ofEnableSizing];
|
||||
F.Filter:='Lazarus project group|*.lpg|All files|'+AllFilesMask;
|
||||
if F.Execute then
|
||||
LoadProjectGroup(FileName,[]);
|
||||
StoreIDEFileDialog(F);
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroupManager.DoSaveClick(Sender: TObject);
|
||||
begin
|
||||
SaveProjectGroup;
|
||||
end;
|
||||
|
||||
Function TIDEProjectGroupManager.GetNewFileName : Boolean;
|
||||
Var
|
||||
F : TSaveDialog;
|
||||
begin
|
||||
Result:=False;
|
||||
F:=TSaveDialog.Create(Nil);
|
||||
With F do
|
||||
try
|
||||
FileName:=FProjectGroup.FileName;
|
||||
InitIDEFileDialog(F);
|
||||
F.Options:=[ofOverwritePrompt,ofPathMustExist,ofEnableSizing];
|
||||
F.Filter:='Lazarus project group|*.lpg|All files|'+AllFilesMask;
|
||||
F.DefaultExt:='.lpg';
|
||||
Result:=F.Execute;
|
||||
if Result then
|
||||
FProjectGroup.FileName:=TrimAndExpandFilename(FileName);
|
||||
StoreIDEFileDialog(F);
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroupManager.DoSaveAsClick(Sender: TObject);
|
||||
begin
|
||||
if GetNewFileName then
|
||||
SaveProjectGroup;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroupManager.LoadProjectGroup(AFileName: string;
|
||||
AOptions: TProjectGroupLoadOptions);
|
||||
begin
|
||||
AFileName:=TrimAndExpandFilename(AFileName);
|
||||
if Not CheckSaved then
|
||||
Exit;
|
||||
FreeAndNil(FProjectGroup);
|
||||
FProjectGroup:=TIDEProjectGroup.Create;
|
||||
FProjectGroup.FileName:=AFileName;
|
||||
FProjectGroup.LoadFromFile(AOptions);
|
||||
If not (pgloSkipDialog in AOptions) then
|
||||
ShowProjectGroupEditor;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroupManager.SaveProjectGroup;
|
||||
begin
|
||||
If Assigned(FProjectGroup) then
|
||||
begin
|
||||
If (FProjectGroup.FileName<>'') or GetNewFileName then
|
||||
FProjectGroup.SaveToFile;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TProjectGroupTarget }
|
||||
|
||||
procedure TProjectGroupTarget.SetTargetType(AValue: TTargetType);
|
||||
begin
|
||||
if (AValue<>ttProjectGroup) then
|
||||
Raise Exception.Create(lisErronlyProjectGroupAllowed);
|
||||
inherited SetTargetType(AValue);
|
||||
end;
|
||||
|
||||
Constructor TProjectGroupTarget.Create(AProjectGroup: TProjectGroup);
|
||||
begin
|
||||
FTarget:=AProjectGroup;
|
||||
TargetType:=ttProjectGroup;
|
||||
end;
|
||||
|
||||
{ TIDEProjectGroup }
|
||||
|
||||
procedure TIDEProjectGroup.SetFileName(AValue: String);
|
||||
begin
|
||||
if FileName=AValue then Exit;
|
||||
inherited SetFileName(AValue);
|
||||
if Assigned(FOnFileNameChange) then
|
||||
FOnFileNameChange(Self);
|
||||
end;
|
||||
|
||||
function TIDEProjectGroup.GetModified: Boolean;
|
||||
begin
|
||||
Result:=FModified;
|
||||
end;
|
||||
|
||||
function TIDEProjectGroup.GetTarget(AIndex: Integer): TCompileTarget;
|
||||
begin
|
||||
Result:=TCompileTarget(FTargets[AIndex]);
|
||||
end;
|
||||
|
||||
function TIDEProjectGroup.GetTargetCount: Integer;
|
||||
begin
|
||||
Result:=FTargets.Count;
|
||||
end;
|
||||
|
||||
Constructor TIDEProjectGroup.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FTargets:=TFPObjectList.Create(True);
|
||||
end;
|
||||
|
||||
Function TIDEProjectGroup.AddTarget(Const AFileName: String): TCompileTarget;
|
||||
begin
|
||||
Result:=Nil;
|
||||
if FileExistsCached(AFileName) then
|
||||
begin
|
||||
Result:=TIDECompileTarget.Create;
|
||||
Result.FileName:=AFileName;
|
||||
FTargets.Add(Result);
|
||||
FModified:=True;
|
||||
If Assigned(FOnTargetAdded) then
|
||||
FOnTargetAdded(Self,Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroup.RemoveTarget(T: TCompileTarget);
|
||||
begin
|
||||
If Assigned(FOnTargetDeleted) then
|
||||
FOnTargetDeleted(Self,T);
|
||||
inherited RemoveTarget(T);
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroup.ExchangeTargets(ASource, ATarget: Integer);
|
||||
begin
|
||||
if ASource=ATarget then exit;
|
||||
if Assigned(FOnTargetsExchanged) then
|
||||
FOnTargetsExchanged(Self,GetTarget(ASource),GetTarget(ATarget));
|
||||
FTargets.Exchange(ASource,ATarget);
|
||||
FModified:=True;
|
||||
end;
|
||||
|
||||
Procedure TIDEProjectGroup.ActivateTarget(T: TCompileTarget);
|
||||
begin
|
||||
if T.Active then exit;
|
||||
inherited ActivateTarget(T);
|
||||
If Assigned(FOnTargetActivated) then
|
||||
FOnTargetActivated(Self,T);
|
||||
end;
|
||||
|
||||
Function TIDEProjectGroup.LoadFromFile(Options: TProjectGroupLoadOptions
|
||||
): Boolean;
|
||||
Var
|
||||
ARoot : String;
|
||||
TargetFileName : String;
|
||||
TargetPath : String;
|
||||
XMLConfig : TXMLConfig;
|
||||
I,ACount : Integer;
|
||||
Target : TCompileTarget;
|
||||
begin
|
||||
TargetPath:=ExpandFileNameUTF8(ExtractFilePath(FileName));
|
||||
Result:=True;
|
||||
try
|
||||
XMLConfig := TXMLConfig.Create(FileName);
|
||||
try
|
||||
ARoot:='ProjectGroup';
|
||||
ACount:=XMLConfig.GetValue(ARoot+'/Targets/Count',0);
|
||||
I:=0;
|
||||
While Result and (I<ACount) do
|
||||
begin
|
||||
Target:=Nil;
|
||||
TargetFileName:=XMLConfig.GetValue(Format(ARoot+'/Targets/Target%d/FileName',[i]),'');
|
||||
TargetFileName:=TrimFilename(SetDirSeparators(TargetFileName));
|
||||
if not FilenameIsAbsolute(TargetFileName) then
|
||||
TargetFileName:=TargetPath+TargetFileName;
|
||||
If (TargetFileName<>'') and FileExistsCached(TargetFileName) then
|
||||
Target:=AddTarget(TargetFileName)
|
||||
else if (pgloRemoveInvalid in Options) then
|
||||
begin
|
||||
Target:=AddTarget(TargetFileName);
|
||||
Target.Removed:=True;
|
||||
end
|
||||
else if (pgloSkipInvalid in options) then
|
||||
// Do nothing
|
||||
else if (pgloErrorInvalid in options) then
|
||||
Result:=False
|
||||
else
|
||||
Case IDEQuestionDialog(lisErrTargetDoesNotExist,
|
||||
Format(lisErrNoSuchFile,[TargetFileName]),mtWarning,
|
||||
[mrYes,lisRemoveTarget,
|
||||
mrNo,lisAbortLoadingProjectGroup,
|
||||
mrYesToAll,lisSkipAllTargets],'') of
|
||||
mrYes :
|
||||
begin
|
||||
Target:=AddTarget(TargetFileName);
|
||||
Target.Removed:=True;
|
||||
end;
|
||||
mrNo:
|
||||
Result:=False;
|
||||
mrYesToAll:
|
||||
begin
|
||||
Target:=AddTarget(TargetFileName);
|
||||
Target.Removed:=True;
|
||||
end;
|
||||
else
|
||||
Result:=False;
|
||||
end;
|
||||
if Assigned(Target) and Not Target.Removed then
|
||||
if XMLConfig.GetValue(Format(ARoot+'/Targets/Target%d/Active',[i]),False) then
|
||||
ActivateTarget(Target);
|
||||
Inc(I);
|
||||
end;
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
IDEMessageDialog('Read Error','Error reading project group file "'+Filename+'"'#13+E.Message,
|
||||
mtError,[mbOk]);
|
||||
Result:=false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TIDEProjectGroup.SaveToFile: Boolean;
|
||||
Var
|
||||
TargetPath : String;
|
||||
RelativeFileName : String;
|
||||
ARoot : String;
|
||||
XMLConfig : TXMLConfig;
|
||||
I,ACount : Integer;
|
||||
CompTarget : TCompileTarget;
|
||||
begin
|
||||
TargetPath:=ExtractFilePath(FileName);
|
||||
Result:=True;
|
||||
try
|
||||
XMLConfig := TXMLConfig.Create(FileName);
|
||||
try
|
||||
ARoot:='ProjectGroup';
|
||||
ACount:=0;
|
||||
For I:=0 to TargetCount-1 do
|
||||
if not GetTarget(I).Removed then
|
||||
Inc(ACount);
|
||||
XMLConfig.Clear;
|
||||
XMLConfig.SetValue(ARoot+'/Targets/Count',ACount);
|
||||
I:=0;
|
||||
ACount:=0;
|
||||
For I:=0 to TargetCount-1 do
|
||||
begin
|
||||
CompTarget:=GetTarget(I);
|
||||
If not CompTarget.Removed then
|
||||
begin
|
||||
RelativeFileName:=ExtractRelativepath(TargetPath,CompTarget.FileName);
|
||||
XMLConfig.SetValue(Format(ARoot+'/Targets/Target%d/FileName',[ACount]),RelativeFileName);
|
||||
Inc(ACount);
|
||||
end;
|
||||
end;
|
||||
XMLConfig.Flush;
|
||||
FModified:=False;
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
IDEMessageDialog('Write Error','Unable to write project group file "'+Filename+'"'#13+E.Message,
|
||||
mtError,[mbOk]);
|
||||
Result:=false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TIDECompileTarget }
|
||||
|
||||
Procedure TIDECompileTarget.LoadTarget;
|
||||
begin
|
||||
Case TargetType of
|
||||
ttProject : LoadProject;
|
||||
ttPackage : LoadPackage;
|
||||
ttProjectGroup : LoadProjectGroup;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TIDECompileTarget.UnLoadTarget;
|
||||
begin
|
||||
if (FTarget<>Nil) and (FTarget is TProjectGroup) then
|
||||
FreeAndNil(FTarget);
|
||||
FTarget:=Nil;
|
||||
end;
|
||||
|
||||
Procedure TIDECompileTarget.LoadPackage;
|
||||
|
||||
Var
|
||||
MR : TModalResult;
|
||||
I : Integer;
|
||||
Pkg : TIDEPackage;
|
||||
|
||||
begin
|
||||
FTarget:=Nil;
|
||||
MR:=PackageEditingInterface.DoOpenPackageFile(Filename,
|
||||
[pofRevert, pofConvertMacros, pofDoNotOpenEditor],
|
||||
False);
|
||||
If (MR=mrOK) then
|
||||
begin
|
||||
I:=0;
|
||||
While (FTarget=Nil) and (I<PackageEditingInterface.GetPackageCount) do
|
||||
begin
|
||||
Pkg:=PackageEditingInterface.GetPackages(I);
|
||||
If CompareFilenames(Pkg.Filename,Self.Filename)=0 then
|
||||
FTarget:=Pkg; // ToDo: free notification
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TIDECompileTarget.LoadProject;
|
||||
|
||||
Const
|
||||
Flags = [];
|
||||
{ Flags = [ofOnlyIfExists, ofProjectLoading, ofQuiet, ofVirtualFile,
|
||||
ofUseCache, ofMultiOpen, ofDoNotLoadResource,
|
||||
ofLoadHiddenResource, ofInternalFile];}
|
||||
|
||||
Var
|
||||
MR : TModalResult;
|
||||
|
||||
begin
|
||||
UnloadTarget;
|
||||
MR:=LazarusIDE.DoOpenProjectFile(FileName,Flags);
|
||||
if (MR=mrOK) then
|
||||
FTarget:=LazarusIDE.ActiveProject; // ToDo: free notification
|
||||
end;
|
||||
|
||||
Procedure TIDECompileTarget.LoadProjectGroup;
|
||||
|
||||
Var
|
||||
PG : TIDEProjectGroup;
|
||||
|
||||
begin
|
||||
PG:=TIDEProjectGroup.Create;
|
||||
PG.FileName:=Self.FileName;
|
||||
PG.LoadFromFile([]);
|
||||
end;
|
||||
|
||||
Function TIDECompileTarget.ProjectAction(AAction: TTargetAction): TActionResult;
|
||||
Var
|
||||
F : TProjectBuildFlags;
|
||||
begin
|
||||
Result:=arOK;
|
||||
If (LazarusIDE.ActiveProject.ProjectInfoFile<>LazProject.ProjectInfoFile) then
|
||||
if LazarusIDE.DoOpenProjectFile(FileName,[ofOnlyIfExists,ofQuiet,ofUseCache])<>mrOK then
|
||||
exit;
|
||||
// If action was open, we're now all set
|
||||
Case AAction of
|
||||
taSettings :
|
||||
; // TODO : Need IDE integration
|
||||
taCompileClean,
|
||||
taCompile :
|
||||
begin
|
||||
F:=[];
|
||||
if (AAction=taCompileClean) then
|
||||
Include(F,pbfCleanCompile);
|
||||
LazarusIDE.DoBuildProject(crCompile,F);
|
||||
end;
|
||||
taRun :
|
||||
; // TODO : Need IDE integration
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TIDECompileTarget.PackageAction(AAction: TTargetAction): TActionResult;
|
||||
Var
|
||||
L : TObjectList;
|
||||
begin
|
||||
Result:=arOK;
|
||||
if (AAction in [taOpen,taSettings]) then
|
||||
PackageEditingInterface.DoOpenPackageFile(FileName,[],False);
|
||||
Case AAction of
|
||||
taSettings :
|
||||
; // TODO : Need IDE integration
|
||||
taCompile :
|
||||
; // TODO : Need IDE integration
|
||||
taCompileClean :
|
||||
; // TODO : Need IDE integration
|
||||
taInstall :
|
||||
begin
|
||||
L:=TObjectList.Create(False);
|
||||
try
|
||||
L.Add(LazPackage);
|
||||
PackageEditingInterface.InstallPackages(L,[]);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
taUninstall :
|
||||
; // TODO : Need IDE integration
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TIDECompileTarget.ProjectGroupAction(AAction: TTargetAction
|
||||
): TActionResult;
|
||||
begin
|
||||
if AAction=taOpen then
|
||||
ProjectGroupManager.LoadProjectGroup(FileName,[])
|
||||
else
|
||||
Result:=GetProjectGroup.PerformFrom(0,AAction);
|
||||
end;
|
||||
|
||||
function TIDECompileTarget.GetIDEPackage: TIDEPackage;
|
||||
begin
|
||||
If FTarget=Nil then
|
||||
LoadTarget;
|
||||
Result:=TIDEPackage(FTarget);
|
||||
end;
|
||||
|
||||
function TIDECompileTarget.GetLazProject: TLazProject;
|
||||
begin
|
||||
If FTarget=Nil then
|
||||
LoadTarget;
|
||||
Result:=TLazProject(FTarget);
|
||||
end;
|
||||
|
||||
function TIDECompileTarget.GetProjectGroup: TProjectGroup;
|
||||
begin
|
||||
If FTarget=Nil then
|
||||
LoadTarget;
|
||||
Result:=TProjectGroup(FTarget);
|
||||
end;
|
||||
|
||||
function TIDECompileTarget.PerformAction(AAction: TTargetAction): TActionResult;
|
||||
begin
|
||||
if FTarget=Nil then
|
||||
LoadTarget;
|
||||
Case TargetType of
|
||||
ttProject : Result:=ProjectAction(AAction);
|
||||
ttPackage : Result:=PackageAction(AAction);
|
||||
ttProjectGroup : Result:=ProjectGroupAction(AAction);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
1224
components/projectgroups/projectgroupeditor.lfm
Normal file
1224
components/projectgroups/projectgroupeditor.lfm
Normal file
File diff suppressed because it is too large
Load Diff
1064
components/projectgroups/projectgroupeditor.pas
Normal file
1064
components/projectgroups/projectgroupeditor.pas
Normal file
File diff suppressed because it is too large
Load Diff
334
components/projectgroups/projectgroupintf.pp
Normal file
334
components/projectgroups/projectgroupintf.pp
Normal file
@ -0,0 +1,334 @@
|
||||
unit ProjectGroupIntf;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, IDEOptionsIntf, PackageIntf, ProjectIntf, LazFileUtils;
|
||||
|
||||
Type
|
||||
TTargetType = (ttUnknown, ttProject, ttPackage, ttProjectGroup);
|
||||
TTargetTypes = set of TTargetType;
|
||||
TTargetAction = (taOpen,taSettings,taCompile,taCompileClean,taRun,taInstall,taUninstall);
|
||||
TTargetActions = set of TTargetAction;
|
||||
TActionResult = (arNotAllowed,arOK,arFailed);
|
||||
TActionResults = set of TActionResult;
|
||||
|
||||
TProjectGroup = CLass;
|
||||
|
||||
{ TCompileTarget - can be a project, package or project group}
|
||||
|
||||
TCompileTarget = class
|
||||
private
|
||||
FActive: Boolean;
|
||||
FFilename: string;
|
||||
FTargetType: TTargetType;
|
||||
FRemoved: boolean;
|
||||
protected
|
||||
Function PerformAction (AAction : TTargetAction) : TActionResult; virtual; abstract;
|
||||
Function Perform (AAction : TTargetAction) : TActionResult;
|
||||
// By default, return all allowed actions for target type.
|
||||
function GetAllowedActions: TTargetActions; virtual;
|
||||
function GetLazProject: TLazProject; virtual; abstract;
|
||||
function GetProjectGroup: TProjectGroup; virtual; abstract;
|
||||
procedure SetTargetType(AValue: TTargetType); virtual;
|
||||
procedure SetFilename(const AValue: string); virtual;
|
||||
function GetIDEPackage: TIDEPackage; virtual; abstract;
|
||||
procedure SetRemoved(const AValue: boolean); virtual;
|
||||
Procedure Activate; virtual;
|
||||
Procedure DeActivate; virtual;
|
||||
public
|
||||
// Fully qualified FileName. Not relative. (ToDo: store them relative)
|
||||
property Filename: string read FFilename write SetFilename;
|
||||
property Removed: boolean read FRemoved write SetRemoved;
|
||||
property TargetType: TTargetType read FTargetType write SetTargetType;
|
||||
property Active : Boolean Read FActive;
|
||||
// Currently allowed actions.
|
||||
property AllowedActions : TTargetActions Read GetAllowedActions;
|
||||
//
|
||||
property LazPackage: TIDEPackage read GetIDEPackage;
|
||||
property LazProject : TLazProject Read GetLazProject;
|
||||
property ProjectGroup : TProjectGroup Read GetProjectGroup;
|
||||
end;
|
||||
|
||||
{ TProjectGroup }
|
||||
|
||||
TProjectGroup = Class(TPersistent)
|
||||
private
|
||||
FFileName: String;
|
||||
function GetActiveTarget: TCompileTarget;
|
||||
procedure SetActiveTarget(AValue: TCompileTarget);
|
||||
Protected
|
||||
procedure SetFileName(AValue: String); virtual;
|
||||
function GetTargetCount: Integer; virtual; abstract;
|
||||
function GetModified: Boolean; virtual; abstract;
|
||||
function GetTarget(AIndex : Integer): TCompileTarget; virtual; abstract;
|
||||
Public
|
||||
Function Perform(AIndex : Integer;AAction : TTargetAction) : TActionResult;
|
||||
Function Perform(Const AFileName : String;AAction : TTargetAction) : TActionResult;
|
||||
Function Perform(ATarget : TCompileTarget; AAction : TTargetAction) : TActionResult; virtual;
|
||||
Function ActionAllowsFrom(AIndex : Integer;AAction : TTargetAction) : Boolean; virtual;
|
||||
Function PerformFrom (AIndex : Integer;AAction : TTargetAction) : TActionResult; virtual;
|
||||
Function IndexOfTarget(Const T : TCompileTarget) : Integer; virtual;
|
||||
Function IndexOfTarget(Const AFilename : String) : Integer; virtual;
|
||||
Function AddTarget(Const AFileName : String) : TCompileTarget; virtual; abstract;
|
||||
Procedure ExchangeTargets(ASource,ATarget : Integer); virtual; abstract;
|
||||
Procedure RemoveTarget(AIndex : Integer);
|
||||
Procedure RemoveTarget(Const AFileName : String) ;
|
||||
Procedure RemoveTarget(T : TCompileTarget) ; virtual;
|
||||
Procedure ActivateTarget(AIndex : Integer);
|
||||
Procedure ActivateTarget(Const AFileName : String);
|
||||
Procedure ActivateTarget(T : TCompileTarget); virtual;
|
||||
Property FileName : String Read FFileName Write SetFileName;
|
||||
Property Targets[AIndex : Integer] : TCompileTarget Read GetTarget;
|
||||
Property TargetCount : Integer Read GetTargetCount;
|
||||
Property ActiveTarget : TCompileTarget Read GetActiveTarget Write SetActiveTarget;
|
||||
Property Modified : Boolean Read GetModified;
|
||||
end;
|
||||
|
||||
TProjectGroupLoadOption = (
|
||||
pgloRemoveInvalid, // Mark non-existing targets from group as removed.
|
||||
pgloSkipInvalid, // Ignore non-existing, add as-is.
|
||||
pgloErrorInvalid, // Stop with error on non-existing.
|
||||
pgloSkipDialog // do not show Project Group editor.
|
||||
);
|
||||
TProjectGroupLoadOptions = set of TProjectGroupLoadOption;
|
||||
|
||||
{ TProjectGroupManager }
|
||||
|
||||
TProjectGroupManager = Class(TPersistent)
|
||||
protected
|
||||
function GetCurrentProjectGroup: TProjectGroup; virtual; abstract;
|
||||
Public
|
||||
Procedure LoadProjectGroup(AFileName : string; AOptions : TProjectGroupLoadOptions); virtual; abstract;
|
||||
Procedure SaveProjectGroup; virtual; abstract;
|
||||
Property CurrentProjectGroup : TProjectGroup Read GetCurrentProjectGroup; // Always top-level.
|
||||
end;
|
||||
|
||||
Var
|
||||
ProjectGroupManager : TProjectGroupManager = nil;
|
||||
|
||||
Function TargetTypeFromExtenstion (AExt : String) : TTargetType;
|
||||
Function TargetActions(ATarget : TTargetType) : TTargetActions;
|
||||
Function TargetSupportsAction(ATarget : TTargetType; AAction : TTargetAction) : Boolean;
|
||||
Function ActionAllowsMulti(AAction : TTargetAction) : Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
Function TargetTypeFromExtenstion (AExt : String) : TTargetType;
|
||||
begin
|
||||
While (AExt<>'') and (AExt[1]='.') do
|
||||
Delete(AExt,1,1);
|
||||
Case LowerCase(AExt) of
|
||||
'lpi',
|
||||
'lpr' : Result:=ttProject;
|
||||
'lpk' : Result:=ttPackage;
|
||||
'lpg' : Result:=ttProjectGroup;
|
||||
else
|
||||
Result:=ttUnknown;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TargetActions(ATarget: TTargetType): TTargetActions;
|
||||
begin
|
||||
begin
|
||||
Case ATarget of
|
||||
ttUnknown : Result:=[];
|
||||
ttProject : Result:=[taOpen,taSettings,taCompile,taCompileClean,taRun];
|
||||
ttPackage : Result:=[taOpen,taSettings,taCompile,taCompileClean,taInstall,taUninstall];
|
||||
ttProjectGroup : Result:=[taOpen,taCompile,taCompileClean];
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TargetSupportsAction(ATarget: TTargetType; AAction: TTargetAction
|
||||
): Boolean;
|
||||
begin
|
||||
Result:=AAction in TargetActions(ATarget);
|
||||
end;
|
||||
|
||||
Function ActionAllowsMulti(AAction: TTargetAction): Boolean;
|
||||
begin
|
||||
Result:=AAction in [taCompile,taCompileClean];
|
||||
end;
|
||||
|
||||
|
||||
{ TProjectGroup }
|
||||
|
||||
function TProjectGroup.GetActiveTarget: TCompileTarget;
|
||||
Var
|
||||
I : Integer;
|
||||
begin
|
||||
I:=0;
|
||||
for i:=0 to TargetCount-1 do
|
||||
begin
|
||||
Result:=GetTarget(I);
|
||||
if Result.Active then exit;
|
||||
end;
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
procedure TProjectGroup.SetActiveTarget(AValue: TCompileTarget);
|
||||
begin
|
||||
ActivateTarget(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectGroup.SetFileName(AValue: String);
|
||||
begin
|
||||
if FFileName=AValue then Exit;
|
||||
FFileName:=AValue;
|
||||
end;
|
||||
|
||||
Function TProjectGroup.Perform(AIndex: Integer; AAction: TTargetAction
|
||||
): TActionResult;
|
||||
begin
|
||||
Result:=Perform(GetTarget(AIndex),AAction);
|
||||
end;
|
||||
|
||||
Function TProjectGroup.Perform(Const AFileName: String; AAction: TTargetAction
|
||||
): TActionResult;
|
||||
begin
|
||||
Result:=Perform(IndexOfTarget(AFileName),AAction);
|
||||
end;
|
||||
|
||||
Function TProjectGroup.Perform(ATarget: TCompileTarget; AAction : TTargetAction): TActionResult;
|
||||
begin
|
||||
Result:=ATarget.Perform(AAction);
|
||||
end;
|
||||
|
||||
Function TProjectGroup.ActionAllowsFrom(AIndex: Integer; AAction: TTargetAction
|
||||
): Boolean;
|
||||
Var
|
||||
C : Integer;
|
||||
T : TCompileTarget;
|
||||
begin
|
||||
Result:=ActionAllowsMulti(AAction);
|
||||
C:=TargetCount;
|
||||
While Result and (AIndex<C) do
|
||||
begin
|
||||
T:=GetTarget(AIndex);
|
||||
if not T.Removed then
|
||||
Result:=AAction in T.AllowedActions;;
|
||||
Inc(AIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TProjectGroup.PerformFrom(AIndex: Integer; AAction: TTargetAction
|
||||
): TActionResult;
|
||||
Var
|
||||
I : Integer;
|
||||
begin
|
||||
Result:=arOK;
|
||||
I:=AIndex;
|
||||
While (Result=arOK) and (I<TargetCount) do
|
||||
if Not GetTarget(i).Removed then
|
||||
begin
|
||||
Result:=Perform(I,AAction);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TProjectGroup.IndexOfTarget(Const T: TCompileTarget): Integer;
|
||||
begin
|
||||
Result:=TargetCount-1;
|
||||
While (Result>=0) and (T<>GetTarget(Result)) do
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
Function TProjectGroup.IndexOfTarget(Const AFilename: String): Integer;
|
||||
begin
|
||||
Result:=TargetCount-1;
|
||||
While (Result>=0) and (CompareFilenames(AFileName,GetTarget(Result).Filename)<>0) do
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
Procedure TProjectGroup.RemoveTarget(AIndex: Integer);
|
||||
begin
|
||||
RemoveTarget(Targets[AIndex])
|
||||
end;
|
||||
|
||||
Procedure TProjectGroup.RemoveTarget(Const AFileName: String);
|
||||
begin
|
||||
RemoveTarget(IndexOfTarget(AFileName))
|
||||
end;
|
||||
|
||||
Procedure TProjectGroup.RemoveTarget(T: TCompileTarget);
|
||||
begin
|
||||
T.Removed:=True;
|
||||
end;
|
||||
|
||||
Procedure TProjectGroup.ActivateTarget(AIndex: Integer);
|
||||
begin
|
||||
ActivateTarget(GetTarget(AIndex));
|
||||
end;
|
||||
|
||||
Procedure TProjectGroup.ActivateTarget(Const AFileName: String);
|
||||
begin
|
||||
ActivateTarget(IndexOfTarget(AFileName));
|
||||
end;
|
||||
|
||||
Procedure TProjectGroup.ActivateTarget(T: TCompileTarget);
|
||||
Var
|
||||
I : Integer;
|
||||
TD : TCompileTarget;
|
||||
begin
|
||||
if T.Active then exit;
|
||||
For I:=0 to TargetCount-1 do
|
||||
begin
|
||||
TD:=GetTarget(I);
|
||||
If TD.Active then
|
||||
TD.Deactivate;
|
||||
end;
|
||||
T.Activate;
|
||||
end;
|
||||
|
||||
{ TCompileTarget }
|
||||
|
||||
function TCompileTarget.GetAllowedActions: TTargetActions;
|
||||
begin
|
||||
Result:=TargetActions(TargetType)
|
||||
end;
|
||||
|
||||
procedure TCompileTarget.SetTargetType(AValue: TTargetType);
|
||||
begin
|
||||
if FTargetType=AValue then Exit;
|
||||
FTargetType:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCompileTarget.SetFilename(const AValue: string);
|
||||
begin
|
||||
if FFileName=AValue then Exit;
|
||||
FFileName:=AValue;
|
||||
TargetType:=TargetTypeFromExtenstion(ExtractFileExt(AValue));
|
||||
end;
|
||||
|
||||
procedure TCompileTarget.SetRemoved(const AValue: boolean);
|
||||
begin
|
||||
if Removed=AValue then exit;
|
||||
FRemoved:=AValue;
|
||||
If FRemoved then
|
||||
Deactivate;
|
||||
end;
|
||||
|
||||
procedure TCompileTarget.Activate;
|
||||
begin
|
||||
FActive:=True;
|
||||
end;
|
||||
|
||||
procedure TCompileTarget.DeActivate;
|
||||
begin
|
||||
FActive:=False;
|
||||
end;
|
||||
|
||||
Function TCompileTarget.Perform(AAction: TTargetAction) : TActionResult;
|
||||
begin
|
||||
if Not (AAction in AllowedActions) then
|
||||
Result:=arNotAllowed
|
||||
else
|
||||
Result:=PerformAction(AAction);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
90
components/projectgroups/regprojectgroup.pp
Normal file
90
components/projectgroups/regprojectgroup.pp
Normal file
@ -0,0 +1,90 @@
|
||||
unit RegProjectGroup;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{$IFNDEF IwrotethiscodePG}
|
||||
{$ERROR This package is under construction}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ProjectGroupIntf, MenuIntf,
|
||||
ProjectGroup, ProjectGroupEditor;
|
||||
|
||||
procedure RegisterStandardProjectGroupMenuItems;
|
||||
Procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
ProjectGroupEditorMenuRootName = 'ProjectGroupEditorMenu';
|
||||
|
||||
Resourcestring
|
||||
lisTargetAdd = 'Add target';
|
||||
lisTargetRemove = 'Remove target';
|
||||
lisTargetCompile = 'Compile';
|
||||
lisTargetCompileClean = 'Compile clean';
|
||||
lisTargetInstall = 'Install';
|
||||
lisTargetUnInstall = 'Uninstall';
|
||||
lisTargetActivate = 'Activate target';
|
||||
lisTargetOpen = 'Open Target';
|
||||
lisTargetRun = 'Run Target';
|
||||
lisTargetProperties = 'Target properties';
|
||||
lisTargetLater = 'Compile target later';
|
||||
lisTargetEarlier = 'Compile target earlier';
|
||||
lisNewProjectGroup = 'New Project group';
|
||||
lisOpenProjectGroup = 'Open Project group';
|
||||
lisSaveProjectGroup = 'Save Project group';
|
||||
lisSaveProjectGroupAs = 'Save Project group as';
|
||||
|
||||
|
||||
procedure RegisterStandardProjectGroupMenuItems;
|
||||
|
||||
var
|
||||
P,S : TIDEMenuSection;
|
||||
|
||||
begin
|
||||
S:=RegisterIDEMenuRoot(ProjectGroupEditorMenuRootName);
|
||||
ProjectGroupMenuRoot:=S;
|
||||
PGEditMenuSectionFiles:=RegisterIDEMenuSection(S,'File');
|
||||
|
||||
P:=RegisterIDEMenuSection(S,'Compile');
|
||||
PGEditMenuSectionCompile:=P;
|
||||
cmdTargetCompile:=RegisterIDEMenuCommand(P,'TargetCompile',lisTargetCompile);
|
||||
cmdTargetCompileClean:=RegisterIDEMenuCommand(P,'TargetCompileClean',lisTargetCompileClean);
|
||||
|
||||
P:=RegisterIDEMenuSection(S,'AddRemove');
|
||||
PGEditMenuSectionAddRemove:=p;
|
||||
cmdTargetAdd:=RegisterIDEMenuCommand(P,'TargetAdd',lisTargetAdd);
|
||||
cmdTargetRemove:=RegisterIDEMenuCommand(P,'TargetRemove',lisTargetRemove);
|
||||
|
||||
P:=RegisterIDEMenuSection(S,'Use');
|
||||
PGEditMenuSectionUse:=P;
|
||||
cmdTargetInstall:=RegisterIDEMenuCommand(P,'TargetInstall',lisTargetInstall);
|
||||
cmdTargetUninstall:=RegisterIDEMenuCommand(P,'TargetUninstall',lisTargetUninstall);
|
||||
cmdTargetEarlier:=RegisterIDEMenuCommand(P,'TargetEarlier',lisTargetEarlier);
|
||||
cmdTargetLater:=RegisterIDEMenuCommand(P,'TargetLater',lisTargetLater);
|
||||
cmdTargetActivate:=RegisterIDEMenuCommand(P,'TargetActivate',lisTargetActivate);
|
||||
cmdTargetOpen:=RegisterIDEMenuCommand(P,'TargetOpen',lisTargetOpen);
|
||||
cmdTargetRun:=RegisterIDEMenuCommand(P,'TargetRun',lisTargetRun);
|
||||
cmdTargetProperties:=RegisterIDEMenuCommand(P,'TargetProperties',lisTargetProperties);
|
||||
end;
|
||||
|
||||
Procedure Register;
|
||||
|
||||
begin
|
||||
RegisterStandardProjectGroupMenuItems;
|
||||
IDEProjectGroupManager:=TIDEProjectGroupManager.Create;
|
||||
|
||||
cmdCreateProjectGroup:=RegisterIDEMenuCommand(itmProjectNewSection,'NewProjectGroup',lisNewProjectGroup,@IDEProjectGroupManager.DoNewClick);
|
||||
cmdOpenProjectGroup:=RegisterIDEMenuCommand(itmProjectOpenSection,'OpenProjectGroup',lisOpenProjectGroup,@IDEProjectGroupManager.DoOpenClick);
|
||||
cmdSaveProjectGroup:=RegisterIDEMenuCommand(itmProjectSaveSection,'SaveProjectGroup',lisSaveProjectGroup,@IDEProjectGroupManager.DoSaveClick);
|
||||
cmdSaveProjectGroupAs:=RegisterIDEMenuCommand(itmProjectSaveSection,'SaveProjectGroupAs',lisSaveProjectGroupAs,@IDEProjectGroupManager.DoSaveAsClick);
|
||||
|
||||
ProjectGroupManager:=IDEProjectGroupManager;
|
||||
SetProjectGroupEditorCallBack;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user