mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 19:17:52 +02:00
722 lines
21 KiB
ObjectPascal
722 lines
21 KiB
ObjectPascal
{ If you want to extend the package only access this unit.
|
|
}
|
|
unit ProjectGroupIntf;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
// LCL
|
|
Forms,
|
|
// LazUtils
|
|
LazFileUtils, LazFileCache, LazMethodList, LazLoggerBase,
|
|
// IdeIntf
|
|
PackageIntf, ProjectIntf, IDEExternToolIntf;
|
|
|
|
Type
|
|
TPGTargetType = (
|
|
ttUnknown,
|
|
ttProject,
|
|
ttPackage,
|
|
ttProjectGroup, // nested group
|
|
ttPascalFile, // build/run file, parameters stored IDE directives
|
|
ttExternalTool
|
|
);
|
|
TPGTargetTypes = set of TPGTargetType;
|
|
|
|
TPGTargetAction = (
|
|
taOpen,
|
|
taSettings,
|
|
taCompile,
|
|
taCompileClean,
|
|
taCompileFromHere,
|
|
taCompileCleanFromHere,
|
|
taRun,
|
|
taInstall,
|
|
taUninstall);
|
|
TPGTargetActions = set of TPGTargetAction;
|
|
|
|
TPGActionResult = (arNotAllowed,arOK,arFailed);
|
|
TPGActionResults = set of TPGActionResult;
|
|
|
|
TProjectGroup = class;
|
|
TPGCompileTarget = class;
|
|
|
|
{ TPGBuildMode }
|
|
|
|
TPGBuildMode = class
|
|
private
|
|
FCompile: boolean;
|
|
FIdentifier: string;
|
|
FTarget: TPGCompileTarget;
|
|
procedure SetCompile(AValue: boolean);
|
|
public
|
|
constructor Create(aTarget: TPGCompileTarget; const anIdentifier: string; aCompile: boolean);
|
|
property Target: TPGCompileTarget read FTarget;
|
|
property Identifier: string read FIdentifier;
|
|
property Compile: boolean read FCompile write SetCompile;
|
|
end;
|
|
|
|
{ TPGDependency }
|
|
|
|
TPGDependency = class
|
|
private
|
|
FPackageName: string;
|
|
FTarget: TPGCompileTarget;
|
|
public
|
|
constructor Create(aTarget: TPGCompileTarget; const aPkgName: string);
|
|
property Target: TPGCompileTarget read FTarget;
|
|
property PackageName: string read FPackageName;
|
|
end;
|
|
|
|
{ TPGCompileTarget - a node in the tree, see TPGTargetType }
|
|
|
|
TPGCompileTarget = class
|
|
private
|
|
FActive: Boolean;
|
|
FFilename: string;
|
|
FTargetType: TPGTargetType;
|
|
FMissing: boolean;
|
|
protected
|
|
FParent: TPGCompileTarget;
|
|
FProjectGroup: TProjectGroup;
|
|
function CallRunLazbuildHandlers(Tool: TAbstractExternalTool): boolean; virtual;
|
|
function GetAllowedActions: TPGTargetActions; virtual; // By default, return all allowed actions for target type.
|
|
function GetBuildModeCount: integer; virtual; abstract;
|
|
function GetBuildModes(Index: integer): TPGBuildMode; virtual; abstract;
|
|
function GetFileCount: integer; virtual; abstract;
|
|
function GetFiles(Index: integer): string; virtual; abstract;
|
|
function GetRequiredPackageCount: integer; virtual; abstract;
|
|
function GetRequiredPackages(Index: integer): TPGDependency; virtual; abstract;
|
|
function Perform(AAction: TPGTargetAction): TPGActionResult;
|
|
function PerformAction(AAction: TPGTargetAction): TPGActionResult; virtual; abstract;
|
|
procedure SetFilename(const AValue: string); virtual;
|
|
procedure SetMissing(const AValue: boolean); virtual;
|
|
procedure SetTargetType(AValue: TPGTargetType); virtual;
|
|
procedure DoDeactivateChildren;
|
|
procedure ActiveChanged(Sender: TPGCompileTarget); virtual; abstract;
|
|
procedure DoActivate(DeactivateChildren: boolean);
|
|
procedure DoDeActivate(DeactivateParents: boolean);
|
|
public
|
|
constructor Create(aParent: TPGCompileTarget);
|
|
procedure Activate;
|
|
procedure DeActivate;
|
|
function GetOwnerProjectGroup: TProjectGroup;
|
|
function GetRootProjectGroup: TProjectGroup;
|
|
function GetNext(SkipChildren: boolean): TPGCompileTarget;
|
|
function IndexOfBuildMode(aName: string): integer;
|
|
function FindBuildMode(aName: string): TPGBuildMode;
|
|
function PerformBuildModeAction(AAction: TPGTargetAction;
|
|
aModeIdentifier: string): TPGActionResult; virtual; abstract;
|
|
procedure Modified; virtual; abstract;
|
|
property Parent: TPGCompileTarget read FParent;
|
|
property Filename: string read FFilename write SetFilename; // Absolute, not relative.
|
|
property Missing: boolean read FMissing write SetMissing;
|
|
property TargetType: TPGTargetType read FTargetType write SetTargetType;
|
|
property Active: Boolean Read FActive;
|
|
function GetIndex: Integer;
|
|
// Currently allowed actions.
|
|
property AllowedActions: TPGTargetActions Read GetAllowedActions;
|
|
//
|
|
property ProjectGroup: TProjectGroup read FProjectGroup; // only set if TargetType=ttProjectGroup
|
|
property BuildModes[Index: integer]: TPGBuildMode read GetBuildModes;
|
|
property BuildModeCount: integer read GetBuildModeCount;
|
|
property Files[Index: integer]: string read GetFiles;
|
|
property FileCount: integer read GetFileCount;
|
|
property RequiredPackages[Index: integer]: TPGDependency read GetRequiredPackages;
|
|
property RequiredPackageCount: integer read GetRequiredPackageCount;
|
|
end;
|
|
|
|
TProjectGroupHandler = (
|
|
pghDestroy
|
|
);
|
|
|
|
{ TProjectGroup }
|
|
|
|
TProjectGroup = class(TPersistent)
|
|
private
|
|
FHandlers: array[TProjectGroupHandler] of TMethodList;
|
|
FChangeStamp: int64;
|
|
FFileName: String;
|
|
FLastSavedChangeStamp: int64;
|
|
procedure SetModified(AValue: Boolean);
|
|
protected
|
|
FSelfTarget: TPGCompileTarget;
|
|
FParent: TProjectGroup;
|
|
function CallRunLazbuildHandlers(Target: TPGCompileTarget;
|
|
Tool: TAbstractExternalTool): boolean; virtual;
|
|
procedure SetFileName(AValue: String); virtual;
|
|
function GetModified: Boolean; virtual;
|
|
function GetTargetCount: Integer; virtual; abstract;
|
|
function GetTarget(Index: Integer): TPGCompileTarget; virtual; abstract;
|
|
procedure DoCallNotifyHandler(HandlerType: TProjectGroupHandler;
|
|
Sender: TObject); overload;
|
|
procedure AddHandler(HandlerType: TProjectGroupHandler;
|
|
const AMethod: TMethod; AsLast: boolean = false);
|
|
procedure RemoveHandler(HandlerType: TProjectGroupHandler;
|
|
const AMethod: TMethod);
|
|
function GetActiveTarget: TPGCompileTarget; virtual; abstract;
|
|
procedure SetActiveTarget(AValue: TPGCompileTarget); virtual; abstract;
|
|
public
|
|
destructor Destroy; override;
|
|
function GetRootGroup: TProjectGroup;
|
|
property FileName: String Read FFileName Write SetFileName; // absolute
|
|
property SelfTarget: TPGCompileTarget read FSelfTarget; // this group as target
|
|
property Parent: TProjectGroup read FParent;
|
|
// actions
|
|
function Perform(Index: Integer; AAction: TPGTargetAction): TPGActionResult;
|
|
function Perform(Const AFileName: String; AAction: TPGTargetAction): TPGActionResult;
|
|
function Perform(Target: TPGCompileTarget; AAction: TPGTargetAction): TPGActionResult; virtual;
|
|
function ActionAllowsFrom(Index: Integer; AAction: TPGTargetAction): Boolean; virtual;
|
|
function PerformFrom(AIndex: Integer; AAction: TPGTargetAction): TPGActionResult; virtual;
|
|
// targets
|
|
function IndexOfTarget(Const Target: TPGCompileTarget): Integer; overload; virtual; abstract;
|
|
function IndexOfTarget(Const AFilename: String): Integer; overload; virtual;
|
|
function AddTarget(Const AFileName: String): TPGCompileTarget; virtual; abstract;
|
|
function InsertTarget(Const Target: TPGCompileTarget; Index: Integer): Integer; virtual; abstract;
|
|
procedure ExchangeTargets(ASource, ATarget: Integer); virtual; abstract;
|
|
procedure RemoveTarget(Index: Integer); virtual; abstract;
|
|
procedure RemoveTarget(Const AFileName: String);
|
|
procedure RemoveTarget(Target: TPGCompileTarget);
|
|
property Targets[Index: Integer]: TPGCompileTarget Read GetTarget;
|
|
property TargetCount: Integer Read GetTargetCount;
|
|
property ActiveTarget: TPGCompileTarget Read GetActiveTarget Write SetActiveTarget;
|
|
function UpdateMissing: boolean; virtual; abstract; // true if something changed
|
|
public
|
|
// modified
|
|
procedure IncreaseChangeStamp;
|
|
property Modified: Boolean Read GetModified write SetModified;
|
|
property ChangeStamp: int64 read FChangeStamp;
|
|
public
|
|
// handlers
|
|
procedure RemoveAllHandlersOfObject(AnObject: TObject);
|
|
procedure AddHandlerOnDestroy(const OnDestroy: TNotifyEvent; AsLast: boolean = false);
|
|
procedure RemoveHandlerOnDestroy(const OnDestroy: TNotifyEvent);
|
|
end;
|
|
|
|
TProjectGroupLoadOption = (
|
|
pgloRemoveInvalid, // Remove non-existing targets from group automatically while loading
|
|
pgloSkipInvalid, // Mark non-existing as Missing.
|
|
pgloErrorInvalid, // Stop with error on non-existing.
|
|
pgloLoadRecursively, // load all sub nodes
|
|
pgloSkipDialog, // do not show Project Group editor.
|
|
pgloBringToFront // when showing editor, bring it to front
|
|
);
|
|
TProjectGroupLoadOptions = set of TProjectGroupLoadOption;
|
|
|
|
TPGManagerHandler = (
|
|
pgmhRunLazbuild // called before running lazbuild
|
|
);
|
|
TPGManagerHandlers = set of TPGManagerHandler;
|
|
|
|
TPGMRunLazbuildEvent = function(Target: TPGCompileTarget;
|
|
Tool: TAbstractExternalTool): boolean of object; // false = abort
|
|
|
|
{ TProjectGroupManager }
|
|
|
|
TProjectGroupManager = Class(TPersistent)
|
|
private
|
|
FHandlers: array[TPGManagerHandler] of TMethodList;
|
|
protected
|
|
FEditor: TForm;
|
|
function CallRunLazbuildHandlers(Target: TPGCompileTarget;
|
|
Tool: TAbstractExternalTool): boolean; virtual;
|
|
function GetCurrentProjectGroup: TProjectGroup; virtual; abstract;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function NewProjectGroup(AddActiveProject: boolean; BringToFront: boolean = true): boolean; virtual; abstract;
|
|
function LoadProjectGroup(AFileName: string; AOptions: TProjectGroupLoadOptions): boolean; virtual; abstract;
|
|
function SaveProjectGroup: boolean; virtual; abstract;
|
|
function GetSrcPaths: string; virtual; abstract;
|
|
function CanUndo: boolean; virtual; abstract;
|
|
function CanRedo: boolean; virtual; abstract;
|
|
procedure Undo; virtual; abstract;
|
|
procedure Redo; virtual; abstract;
|
|
property CurrentProjectGroup: TProjectGroup Read GetCurrentProjectGroup; // Always top-level.
|
|
property Editor: TForm read FEditor write FEditor;
|
|
public
|
|
// handlers
|
|
procedure RemoveAllHandlersOfObject(AnObject: TObject);
|
|
procedure AddHandlerOnRunLazbuild(const OnRunLazbuild: TPGMRunLazbuildEvent; AsLast: boolean = false);
|
|
procedure RemoveHandlerOnRunLazbuild(const OnRunLazbuild: TPGMRunLazbuildEvent);
|
|
end;
|
|
|
|
var
|
|
ProjectGroupManager: TProjectGroupManager = nil;
|
|
|
|
const
|
|
PGTargetActions: array[TPGTargetType] of TPGTargetActions = (
|
|
[], // ttUnknown
|
|
[taOpen,taSettings,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taRun], // ttProject
|
|
[taOpen,taSettings,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taInstall,taUninstall], // ttPackage
|
|
[taOpen,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere], // ttProjectGroup
|
|
[taOpen,taSettings,taCompile,taCompileFromHere,taRun], // ttPascalFile
|
|
[taOpen,taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taRun] // ttExternalTool
|
|
);
|
|
|
|
function TargetTypeFromExtension(AExt: String): TPGTargetType;
|
|
function TargetSupportsAction(ATarget: TPGTargetType; AAction: TPGTargetAction): Boolean;
|
|
function ActionAllowsMulti(AAction: TPGTargetAction): Boolean;
|
|
|
|
implementation
|
|
|
|
function TargetTypeFromExtension (AExt: String): TPGTargetType;
|
|
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;
|
|
'pas',
|
|
'pp',
|
|
'p' : Result:=ttPascalFile;
|
|
else
|
|
Result:=ttUnknown;
|
|
end;
|
|
end;
|
|
|
|
function TargetSupportsAction(ATarget: TPGTargetType; AAction: TPGTargetAction
|
|
): Boolean;
|
|
begin
|
|
Result:=AAction in PGTargetActions[ATarget];
|
|
end;
|
|
|
|
function ActionAllowsMulti(AAction: TPGTargetAction): Boolean;
|
|
begin
|
|
Result:=AAction in [taCompile,taCompileClean];
|
|
end;
|
|
|
|
{ TProjectGroupManager }
|
|
|
|
function TProjectGroupManager.CallRunLazbuildHandlers(Target: TPGCompileTarget;
|
|
Tool: TAbstractExternalTool): boolean;
|
|
var
|
|
Handler: TMethodList;
|
|
i: Integer;
|
|
begin
|
|
Result:=true;
|
|
Handler:=FHandlers[pgmhRunLazbuild];
|
|
i:=Handler.Count;
|
|
while Handler.NextDownIndex(i) do begin
|
|
if not TPGMRunLazbuildEvent(Handler[i])(Target,Tool) then
|
|
exit(false);
|
|
end;
|
|
end;
|
|
|
|
constructor TProjectGroupManager.Create;
|
|
var
|
|
HandlerType: TPGManagerHandler;
|
|
begin
|
|
for HandlerType in TPGManagerHandler do
|
|
FHandlers[HandlerType]:=TMethodList.Create;
|
|
end;
|
|
|
|
destructor TProjectGroupManager.Destroy;
|
|
var
|
|
HandlerType: TPGManagerHandler;
|
|
begin
|
|
for HandlerType in TPGManagerHandler do
|
|
FreeAndNil(FHandlers[HandlerType]);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TProjectGroupManager.RemoveAllHandlersOfObject(AnObject: TObject);
|
|
var
|
|
HandlerType: TPGManagerHandler;
|
|
begin
|
|
for HandlerType in TPGManagerHandler do
|
|
FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
|
|
end;
|
|
|
|
procedure TProjectGroupManager.AddHandlerOnRunLazbuild(
|
|
const OnRunLazbuild: TPGMRunLazbuildEvent; AsLast: boolean);
|
|
begin
|
|
FHandlers[pgmhRunLazbuild].Add(TMethod(OnRunLazbuild),AsLast);
|
|
end;
|
|
|
|
procedure TProjectGroupManager.RemoveHandlerOnRunLazbuild(
|
|
const OnRunLazbuild: TPGMRunLazbuildEvent);
|
|
begin
|
|
FHandlers[pgmhRunLazbuild].Remove(TMethod(OnRunLazbuild));
|
|
end;
|
|
|
|
{ TPGBuildMode }
|
|
|
|
procedure TPGBuildMode.SetCompile(AValue: boolean);
|
|
begin
|
|
if FCompile=AValue then Exit;
|
|
FCompile:=AValue;
|
|
Target.Modified;
|
|
end;
|
|
|
|
constructor TPGBuildMode.Create(aTarget: TPGCompileTarget; const anIdentifier: string;
|
|
aCompile: boolean);
|
|
begin
|
|
FTarget:=aTarget;
|
|
FIdentifier:=anIdentifier;
|
|
FCompile:=aCompile;
|
|
end;
|
|
|
|
{ TPGDependency }
|
|
|
|
constructor TPGDependency.Create(aTarget: TPGCompileTarget;
|
|
const aPkgName: string);
|
|
begin
|
|
FTarget:=aTarget;
|
|
FPackageName:=aPkgName;
|
|
end;
|
|
|
|
{ TProjectGroup }
|
|
|
|
procedure TProjectGroup.SetModified(AValue: Boolean);
|
|
begin
|
|
if AValue then
|
|
IncreaseChangeStamp
|
|
else
|
|
FLastSavedChangeStamp:=FChangeStamp;
|
|
end;
|
|
|
|
function TProjectGroup.CallRunLazbuildHandlers(Target: TPGCompileTarget;
|
|
Tool: TAbstractExternalTool): boolean;
|
|
begin
|
|
if ProjectGroupManager<>nil then
|
|
Result:=ProjectGroupManager.CallRunLazbuildHandlers(Target,Tool)
|
|
else
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TProjectGroup.SetFileName(AValue: String);
|
|
begin
|
|
if FFileName=AValue then Exit;
|
|
FFileName:=AValue;
|
|
IncreaseChangeStamp;
|
|
if SelfTarget<>nil then
|
|
SelfTarget.Filename:=Filename;
|
|
end;
|
|
|
|
function TProjectGroup.GetModified: Boolean;
|
|
begin
|
|
Result:=FLastSavedChangeStamp<>FChangeStamp;
|
|
end;
|
|
|
|
procedure TProjectGroup.DoCallNotifyHandler(HandlerType: TProjectGroupHandler;
|
|
Sender: TObject);
|
|
begin
|
|
FHandlers[HandlerType].CallNotifyEvents(Sender);
|
|
end;
|
|
|
|
procedure TProjectGroup.AddHandler(HandlerType: TProjectGroupHandler;
|
|
const AMethod: TMethod; AsLast: boolean);
|
|
begin
|
|
if FHandlers[HandlerType]=nil then
|
|
FHandlers[HandlerType]:=TMethodList.Create;
|
|
FHandlers[HandlerType].Add(AMethod,AsLast);
|
|
end;
|
|
|
|
procedure TProjectGroup.RemoveHandler(HandlerType: TProjectGroupHandler;
|
|
const AMethod: TMethod);
|
|
begin
|
|
FHandlers[HandlerType].Remove(AMethod);
|
|
end;
|
|
|
|
destructor TProjectGroup.Destroy;
|
|
var
|
|
HandlerType: TProjectGroupHandler;
|
|
begin
|
|
DoCallNotifyHandler(pghDestroy,Self);
|
|
for HandlerType:=Low(FHandlers) to High(FHandlers) do
|
|
FreeAndNil(FHandlers[HandlerType]);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TProjectGroup.GetRootGroup: TProjectGroup;
|
|
begin
|
|
Result:=Self;
|
|
while Result.Parent<>nil do
|
|
Result:=Result.Parent;
|
|
end;
|
|
|
|
function TProjectGroup.Perform(Index: Integer; AAction: TPGTargetAction
|
|
): TPGActionResult;
|
|
begin
|
|
Result:=Perform(GetTarget(Index),AAction);
|
|
end;
|
|
|
|
function TProjectGroup.Perform(const AFileName: String; AAction: TPGTargetAction
|
|
): TPGActionResult;
|
|
begin
|
|
Result:=Perform(IndexOfTarget(AFileName),AAction);
|
|
end;
|
|
|
|
function TProjectGroup.Perform(Target: TPGCompileTarget; AAction: TPGTargetAction): TPGActionResult;
|
|
begin
|
|
Result:=Target.Perform(AAction);
|
|
end;
|
|
|
|
function TProjectGroup.ActionAllowsFrom(Index: Integer; AAction: TPGTargetAction
|
|
): Boolean;
|
|
Var
|
|
C: Integer;
|
|
T: TPGCompileTarget;
|
|
begin
|
|
Result:=ActionAllowsMulti(AAction);
|
|
C:=TargetCount;
|
|
while Result and (Index<C) do
|
|
begin
|
|
T:=GetTarget(Index);
|
|
if not T.Missing then
|
|
Result:=Result and (AAction in T.AllowedActions);
|
|
Inc(Index);
|
|
end;
|
|
end;
|
|
|
|
function TProjectGroup.PerformFrom(AIndex: Integer; AAction: TPGTargetAction
|
|
): TPGActionResult;
|
|
Var
|
|
I: Integer;
|
|
begin
|
|
Result:=arOK;
|
|
I:=AIndex;
|
|
while (Result=arOK) and (I<TargetCount) do
|
|
begin
|
|
Result:=Perform(I,AAction);
|
|
Inc(I);
|
|
end;
|
|
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(const AFileName: String);
|
|
begin
|
|
RemoveTarget(IndexOfTarget(AFileName))
|
|
end;
|
|
|
|
procedure TProjectGroup.RemoveTarget(Target: TPGCompileTarget);
|
|
begin
|
|
RemoveTarget(IndexOfTarget(Target))
|
|
end;
|
|
|
|
procedure TProjectGroup.IncreaseChangeStamp;
|
|
begin
|
|
LUIncreaseChangeStamp64(FChangeStamp);
|
|
if Parent<>nil then
|
|
Parent.IncreaseChangeStamp;
|
|
end;
|
|
|
|
procedure TProjectGroup.RemoveAllHandlersOfObject(AnObject: TObject);
|
|
var
|
|
HandlerType: TProjectGroupHandler;
|
|
begin
|
|
for HandlerType in TProjectGroupHandler do
|
|
FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
|
|
end;
|
|
|
|
procedure TProjectGroup.AddHandlerOnDestroy(const OnDestroy: TNotifyEvent;
|
|
AsLast: boolean);
|
|
begin
|
|
AddHandler(pghDestroy,TMethod(OnDestroy),AsLast);
|
|
end;
|
|
|
|
procedure TProjectGroup.RemoveHandlerOnDestroy(const OnDestroy: TNotifyEvent);
|
|
begin
|
|
RemoveHandler(pghDestroy,TMethod(OnDestroy));
|
|
end;
|
|
|
|
{ TPGCompileTarget }
|
|
|
|
function TPGCompileTarget.GetIndex: Integer;
|
|
var
|
|
Group: TProjectGroup;
|
|
begin
|
|
if Parent=nil then exit(0);
|
|
Group:=Parent.ProjectGroup;
|
|
if Group=nil then exit(0);
|
|
Result:=Group.IndexOfTarget(Self);
|
|
end;
|
|
|
|
function TPGCompileTarget.CallRunLazbuildHandlers(Tool: TAbstractExternalTool
|
|
): boolean;
|
|
var
|
|
Group: TProjectGroup;
|
|
begin
|
|
Group:=GetOwnerProjectGroup;
|
|
if Group<>nil then
|
|
Result:=Group.CallRunLazbuildHandlers(Self,Tool)
|
|
else
|
|
Result:=true;
|
|
end;
|
|
|
|
function TPGCompileTarget.GetAllowedActions: TPGTargetActions;
|
|
begin
|
|
Result:=PGTargetActions[TargetType];
|
|
end;
|
|
|
|
procedure TPGCompileTarget.SetTargetType(AValue: TPGTargetType);
|
|
begin
|
|
if FTargetType=AValue then Exit;
|
|
FTargetType:=AValue;
|
|
end;
|
|
|
|
procedure TPGCompileTarget.DoDeactivateChildren;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if ProjectGroup=nil then exit;
|
|
for i:=0 to ProjectGroup.TargetCount-1 do
|
|
ProjectGroup.Targets[i].DoDeActivate(false);
|
|
end;
|
|
|
|
procedure TPGCompileTarget.DoActivate(DeactivateChildren: boolean);
|
|
var
|
|
OldActive: TPGCompileTarget;
|
|
PG: TProjectGroup;
|
|
begin
|
|
if DeactivateChildren then
|
|
DoDeactivateChildren;
|
|
if Active then exit;
|
|
if Parent<>nil then
|
|
begin
|
|
PG:=Parent.ProjectGroup;
|
|
if PG<>nil then
|
|
begin
|
|
OldActive:=PG.ActiveTarget;
|
|
if OldActive<>nil then
|
|
OldActive.DoDeActivate(false);
|
|
end;
|
|
Parent.DoActivate(false);
|
|
PG.IncreaseChangeStamp;
|
|
end;
|
|
FActive:=True;
|
|
end;
|
|
|
|
procedure TPGCompileTarget.DoDeActivate(DeactivateParents: boolean);
|
|
begin
|
|
if not Active then exit;
|
|
if ProjectGroup<>nil then
|
|
begin
|
|
ProjectGroup.IncreaseChangeStamp;
|
|
DoDeactivateChildren;
|
|
end;
|
|
FActive:=False;
|
|
if DeactivateParents and (Parent<>nil) then
|
|
Parent.DoDeActivate(true);
|
|
end;
|
|
|
|
constructor TPGCompileTarget.Create(aParent: TPGCompileTarget);
|
|
begin
|
|
FParent:=aParent;
|
|
end;
|
|
|
|
procedure TPGCompileTarget.SetFilename(const AValue: string);
|
|
begin
|
|
if FFileName=AValue then Exit;
|
|
FFileName:=AValue;
|
|
TargetType:=TargetTypeFromExtension(ExtractFileExt(AValue));
|
|
if ProjectGroup<>nil then
|
|
ProjectGroup.FileName:=Filename;
|
|
end;
|
|
|
|
procedure TPGCompileTarget.SetMissing(const AValue: boolean);
|
|
begin
|
|
if Missing=AValue then exit;
|
|
FMissing:=AValue;
|
|
end;
|
|
|
|
procedure TPGCompileTarget.Activate;
|
|
begin
|
|
if Active then exit;
|
|
DoActivate(true);
|
|
ActiveChanged(Self);
|
|
end;
|
|
|
|
procedure TPGCompileTarget.DeActivate;
|
|
begin
|
|
if not Active then exit;
|
|
DoDeActivate(true);
|
|
ActiveChanged(Self);
|
|
end;
|
|
|
|
function TPGCompileTarget.GetOwnerProjectGroup: TProjectGroup;
|
|
var
|
|
aTarget: TPGCompileTarget;
|
|
begin
|
|
aTarget:=Self;
|
|
while (aTarget<>nil) do begin
|
|
Result:=aTarget.ProjectGroup;
|
|
if Result<>nil then exit;
|
|
aTarget:=aTarget.Parent;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TPGCompileTarget.GetRootProjectGroup: TProjectGroup;
|
|
var
|
|
aTarget: TPGCompileTarget;
|
|
begin
|
|
aTarget:=Self;
|
|
while (aTarget.Parent<>nil) do aTarget:=aTarget.Parent;
|
|
Result:=aTarget.ProjectGroup;
|
|
end;
|
|
|
|
function TPGCompileTarget.GetNext(SkipChildren: boolean): TPGCompileTarget;
|
|
var
|
|
aTarget: TPGCompileTarget;
|
|
PG: TProjectGroup;
|
|
i: Integer;
|
|
begin
|
|
// check first child
|
|
if (not SkipChildren) and (ProjectGroup<>nil) and (ProjectGroup.TargetCount>0) then
|
|
exit(ProjectGroup.Targets[0]);
|
|
// check next sibling
|
|
aTarget:=Self;
|
|
while aTarget.Parent<>nil do begin
|
|
PG:=aTarget.Parent.ProjectGroup;
|
|
if PG<>nil then begin
|
|
i:=PG.IndexOfTarget(aTarget);
|
|
if (i>=0) and (i+1<PG.TargetCount) then
|
|
exit(PG.Targets[i+1]);
|
|
end;
|
|
aTarget:=aTarget.Parent;
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TPGCompileTarget.IndexOfBuildMode(aName: string): integer;
|
|
begin
|
|
Result:=BuildModeCount-1;
|
|
while (Result>=0) and (CompareText(aName,BuildModes[Result].Identifier)<>0) do
|
|
dec(Result);
|
|
end;
|
|
|
|
function TPGCompileTarget.FindBuildMode(aName: string): TPGBuildMode;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=IndexOfBuildMode(aName);
|
|
if i>=0 then
|
|
Result:=BuildModes[i]
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TPGCompileTarget.Perform(AAction: TPGTargetAction): TPGActionResult;
|
|
begin
|
|
if Not (AAction in AllowedActions) then
|
|
Result:=arNotAllowed
|
|
else
|
|
Result:=PerformAction(AAction);
|
|
end;
|
|
|
|
end.
|
|
|