paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-14 16:12:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

project groups: prefixed TTargetAction

Browse Source 
git-svn-id: trunk@50337 -
This commit is contained in:
mattias 2015-11-16 10:49:28 +00:00
parent 1950d6e64d
commit d93436b400
4 changed files with 91 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
components/projectgroups/projectgroup.pp
View File

@ -30,13 +30,13 @@ type
procedure LoadPackage;
procedure LoadProject;
procedure LoadProjectGroup;
function ProjectAction(AAction: TTargetAction): TActionResult;
function PackageAction(AAction: TTargetAction): TActionResult;
function ProjectGroupAction(AAction: TTargetAction): TActionResult;
function ProjectAction(AAction: TPGTargetAction): TPGActionResult;
function PackageAction(AAction: TPGTargetAction): TPGActionResult;
function ProjectGroupAction(AAction: TPGTargetAction): TPGActionResult;
function GetIDEPackage: TIDEPackage; override;
function GetLazProject: TLazProject; override;
function GetProjectGroup: TProjectGroup; override;
function PerformAction(AAction: TTargetAction): TActionResult; override;
function PerformAction(AAction: TPGTargetAction): TPGActionResult; override;
public
procedure LoadTarget;
procedure UnLoadTarget;
@ -49,7 +49,7 @@ type
TProjectGroupTarget = Class(TIDECompileTarget)
protected
procedure SetTargetType(AValue: TTargetType); override;
procedure SetTargetType(AValue: TPGTargetType); override;
public
constructor Create(AProjectGroup: TProjectGroup);
end;
@ -119,11 +119,13 @@ type
TEditProjectGroupOption = (epgoReusewindow);
TEditProjectGroupOptions = Set of TEditProjectGroupOption;
TEditProjectGroupHandler = procedure(AProjectGroup: TProjectGroup; Options: TEditProjectGroupOptions);
TEditProjectGroupHandler = procedure(AProjectGroup: TProjectGroup;
Options: TEditProjectGroupOptions);
// Method variant.
TEditProjectGroupEvent = procedure(AProjectGroup: TProjectGroup; Options: TEditProjectGroupOptions) of object;
TEditProjectGroupEvent = procedure(AProjectGroup: TProjectGroup;
Options: TEditProjectGroupOptions) of object;
Var
var
OnEditProjectGroup: TEditProjectGroupHandler; // Takes precedence
OnEditProjectGroupEvent: TEditProjectGroupEvent;
@ -136,7 +138,7 @@ Var
PGEditMenuSectionUse, // Target up/down
PGEditMenuSectionMisc: TIDEMenuSection; // e.g. options
Var
var
cmdOpenProjectGroup,
cmdSaveProjectGroup,
cmdCreateProjectGroup,
@ -197,18 +199,17 @@ begin
end;
function TIDEProjectGroupManager.ShowProjectGroupEditor: Boolean;
begin
Result:=Assigned(FProjectGroup);
if Result then
begin
begin
if Assigned(OnEditProjectGroup) then
OnEditProjectGroup(FProjectGroup,[])
else if Assigned(OnEditProjectGroupEvent) then
OnEditProjectGroupEvent(FProjectGroup,[])
Else
else
Result:=False;
end;
end;
end;
procedure TIDEProjectGroupManager.DoNewClick(Sender: TObject);
@ -221,8 +222,7 @@ begin
end;
procedure TIDEProjectGroupManager.DoOpenClick(Sender: TObject);
Var
var
F: TOpenDialog;
begin
if Not CheckSaved then
@ -247,7 +247,7 @@ begin
end;
function TIDEProjectGroupManager.GetNewFileName: Boolean;
Var
var
F: TSaveDialog;
begin
Result:=False;
@ -299,7 +299,7 @@ end;
{ TProjectGroupTarget }
procedure TProjectGroupTarget.SetTargetType(AValue: TTargetType);
procedure TProjectGroupTarget.SetTargetType(AValue: TPGTargetType);
begin
if (AValue<>ttProjectGroup) then
Raise Exception.Create(lisErronlyProjectGroupAllowed);
@ -601,7 +601,7 @@ begin
PG.LoadFromFile([]);
end;
function TIDECompileTarget.ProjectAction(AAction: TTargetAction): TActionResult;
function TIDECompileTarget.ProjectAction(AAction: TPGTargetAction): TPGActionResult;
var
F: TProjectBuildFlags;
begin
@ -626,7 +626,7 @@ begin
end;
end;
function TIDECompileTarget.PackageAction(AAction: TTargetAction): TActionResult;
function TIDECompileTarget.PackageAction(AAction: TPGTargetAction): TPGActionResult;
Var
L: TObjectList;
begin
@ -655,8 +655,8 @@ begin
end;
end;
function TIDECompileTarget.ProjectGroupAction(AAction: TTargetAction
): TActionResult;
function TIDECompileTarget.ProjectGroupAction(AAction: TPGTargetAction
): TPGActionResult;
begin
if AAction=taOpen then
ProjectGroupManager.LoadProjectGroup(FileName,[])
@ -685,7 +685,7 @@ begin
Result:=TProjectGroup(FTarget);
end;
function TIDECompileTarget.PerformAction(AAction: TTargetAction): TActionResult;
function TIDECompileTarget.PerformAction(AAction: TPGTargetAction): TPGActionResult;
begin
if FTarget=Nil then
LoadTarget;

37
components/projectgroups/projectgroupeditor.lfm
View File

@ -1,11 +1,11 @@
object ProjectGroupEditorForm: TProjectGroupEditorForm
Left = 790
Left = 655
Height = 358
Top = 309
Width = 785
Top = 177
Width = 646
Caption = 'ProjectGroupEditorForm'
ClientHeight = 358
ClientWidth = 785
ClientWidth = 646
OnCreate = FormCreate
OnShow = FormShow
LCLVersion = '1.5'
@ -13,7 +13,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
Left = 0
Height = 48
Top = 0
Width = 785
Width = 646
AutoSize = True
ButtonHeight = 46
Images = ImageListMain
ShowCaptions = True
@ -83,7 +84,7 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
Left = 0
Height = 291
Top = 48
Width = 785
Width = 646
Align = alClient
DefaultItemHeight = 18
HideSelection = False
@ -100,7 +101,7 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
Left = 0
Height = 19
Top = 339
Width = 785
Width = 646
Panels = <
item
Text = '0 targets'
@ -113,8 +114,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
SimplePanel = False
end
object ImageListMain: TImageList
left = 176
top = 144
left = 128
top = 184
Bitmap = {
4C69160000001000000010000000FFFFFF009E6E4D2B9D6D4CD69D6D4BC59D6C
4BFF9C6C4AFF9C6B49FF9B6A49FF9B6A48FF9A6947FF996846FF986745FF9364
@ -825,8 +826,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
end
object PopupMenuMore: TPopupMenu
Images = ImageListMain
left = 352
top = 68
left = 208
top = 96
object PMISaveAs: TMenuItem
Action = AProjectGroupSaveAs
Bitmap.Data = {
@ -870,7 +871,7 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
object ActionListMain: TActionList
Images = ImageListMain
left = 48
top = 144
top = 152
object AProjectGroupSave: TAction
Category = 'ProjectGroupActions'
Caption = 'Save'
@ -972,8 +973,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
end
object PopupMenuTree: TPopupMenu
Images = ImageListMain
left = 288
top = 144
left = 208
top = 152
object PMICompile: TMenuItem
Action = ATargetCompile
Bitmap.Data = {
@ -1215,12 +1216,12 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
end
object OpenDialogTarget: TOpenDialog
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 85
top = 68
left = 48
top = 96
end
object SaveDialogPG: TSaveDialog
Options = [ofPathMustExist, ofEnableSizing, ofViewDetail]
left = 208
top = 68
left = 128
top = 120
end
end

18
components/projectgroups/projectgroupeditor.pas
View File

@ -122,14 +122,14 @@ type
procedure DoTargetDeleted(Sender: TObject; Target: TCompileTarget);
procedure DoTargetActivated(Sender: TObject; Target: TCompileTarget);
procedure DoTargetExchanged(Sender: TObject; Target1, Target2: TCompileTarget);
function AllowPerform(ATargetAction: TTargetAction; AAction: TAction= Nil): Boolean;
function AllowPerform(ATargetAction: TPGTargetAction; AAction: TAction= Nil): Boolean;
procedure ClearEventCallBacks(AProjectGroup: TProjectGroup);
procedure SetEventCallBacks(AProjectGroup: TProjectGroup);
// Some helpers
procedure SetProjectGroup(AValue: TProjectGroup);
procedure ShowDependencies(AParent: TTreeNode; AProjectGroup: TProjectGroup; T: TObject; Out PD: TTargetNodes);
procedure ShowFileName;
procedure Perform(ATargetAction: TTargetAction);
procedure Perform(ATargetAction: TPGTargetAction);
function GetActiveTarget: TCompileTarget;
// Treeview Node management
function FindNodeFromTarget(ATarget: TCompileTarget): TTreeNode;
@ -163,7 +163,7 @@ implementation
{$R *.lfm}
Var
var
// Nodelist image indexes
NIProjectGroup : integer = 0;
NITargets : integer = 1;
@ -203,7 +203,7 @@ Var
iiTargetActivate : Integer = -1;
iiTargetOpen : Integer = -1;
Const
const
// Status bar Panel indexes
piTargetCount = 0;
piActiveTarget = 1;
@ -235,8 +235,8 @@ procedure TProjectGroupEditorForm.ClearEventCallBacks(AProjectGroup: TProjectGro
Var
PG: TIDEProjectGroup;
begin
if AProjectGroup is TIDEProjectGroup then
PG:=AProjectGroup as TIDEProjectGroup
if AProjectGroup is TIDEProjectGroup then
PG:=TIDEProjectGroup(AProjectGroup)
else
exit;
PG.OnFileNameChange:=Nil;
@ -251,7 +251,7 @@ Var
PG: TIDEProjectGroup;
begin
if AProjectGroup is TIDEProjectGroup then
PG:=AProjectGroup as TIDEProjectGroup
PG:=TIDEProjectGroup(AProjectGroup)
else
exit;
PG.OnFileNameChange:=@DoFileNameChange;
@ -583,7 +583,7 @@ begin
UpdateIDEMenuCommandFromAction(Sender,cmdTargetCompileClean);
end;
function TProjectGroupEditorForm.AllowPerform(ATargetAction: TTargetAction; AAction: TAction = Nil): Boolean;
function TProjectGroupEditorForm.AllowPerform(ATargetAction: TPGTargetAction; AAction: TAction = Nil): Boolean;
Var
T: TCompileTarget;
begin
@ -593,7 +593,7 @@ begin
AAction.Enabled:=Result;
end;
procedure TProjectGroupEditorForm.Perform(ATargetAction: TTargetAction);
procedure TProjectGroupEditorForm.Perform(ATargetAction: TPGTargetAction);
Var
T: TNodeData;
begin

82
components/projectgroups/projectgroupintf.pp
View File

@ -10,17 +10,17 @@ uses
Classes, SysUtils, IDEOptionsIntf, PackageIntf, ProjectIntf, LazFileUtils;
Type
TTargetType = (
TPGTargetType = (
ttUnknown,
ttProject,
ttPackage,
ttProjectGroup, // nested group
ttUnit, // build/run file, parameters stored IDE directives
ttFile, // build/run file, parameters stored IDE directives
ttExternalTool
);
TTargetTypes = set of TTargetType;
TPGTargetTypes = set of TPGTargetType;
TTargetAction = (
TPGTargetAction = (
taOpen,
taSettings,
taCompile,
@ -28,10 +28,10 @@ Type
taRun,
taInstall,
taUninstall);
TTargetActions = set of TTargetAction;
TPGTargetActions = set of TPGTargetAction;
TActionResult = (arNotAllowed,arOK,arFailed);
TActionResults = set of TActionResult;
TPGActionResult = (arNotAllowed,arOK,arFailed);
TPGActionResults = set of TPGActionResult;
TProjectGroup = class;
@ -41,16 +41,16 @@ Type
private
FActive: Boolean;
FFilename: string;
FTargetType: TTargetType;
FTargetType: TPGTargetType;
FRemoved: boolean;
protected
function PerformAction (AAction: TTargetAction): TActionResult; virtual; abstract;
function Perform (AAction: TTargetAction): TActionResult;
function PerformAction (AAction: TPGTargetAction): TPGActionResult; virtual; abstract;
function Perform (AAction: TPGTargetAction): TPGActionResult;
// By default, return all allowed actions for target type.
function GetAllowedActions: TTargetActions; virtual;
function GetAllowedActions: TPGTargetActions; virtual;
function GetLazProject: TLazProject; virtual; abstract;
function GetProjectGroup: TProjectGroup; virtual; abstract;
procedure SetTargetType(AValue: TTargetType); virtual;
procedure SetTargetType(AValue: TPGTargetType); virtual;
procedure SetFilename(const AValue: string); virtual;
function GetIDEPackage: TIDEPackage; virtual; abstract;
procedure SetRemoved(const AValue: boolean); virtual;
@ -59,10 +59,10 @@ Type
public
property Filename: string read FFilename write SetFilename; // Absolute, not relative. (ToDo: store them relative)
property Removed: boolean read FRemoved write SetRemoved;
property TargetType: TTargetType read FTargetType write SetTargetType;
property TargetType: TPGTargetType read FTargetType write SetTargetType;
property Active: Boolean Read FActive;
// Currently allowed actions.
property AllowedActions: TTargetActions Read GetAllowedActions;
property AllowedActions: TPGTargetActions Read GetAllowedActions;
//
property LazPackage: TIDEPackage read GetIDEPackage;
property LazProject: TLazProject Read GetLazProject;
@ -84,11 +84,11 @@ Type
function GetRemovedTargetCount: Integer; virtual; abstract;
function GetRemovedTarget(Index: Integer): TCompileTarget; virtual; abstract;
public
function Perform(Index: Integer; AAction: TTargetAction): TActionResult;
function Perform(Const AFileName: String; AAction: TTargetAction): TActionResult;
function Perform(Target: TCompileTarget; AAction: TTargetAction): TActionResult; virtual;
function ActionAllowsFrom(Index: Integer; AAction: TTargetAction): Boolean; virtual;
function PerformFrom(AIndex: Integer; AAction: TTargetAction): TActionResult; virtual;
function Perform(Index: Integer; AAction: TPGTargetAction): TPGActionResult;
function Perform(Const AFileName: String; AAction: TPGTargetAction): TPGActionResult;
function Perform(Target: TCompileTarget; AAction: TPGTargetAction): TPGActionResult; virtual;
function ActionAllowsFrom(Index: Integer; AAction: TPGTargetAction): Boolean; virtual;
function PerformFrom(AIndex: Integer; AAction: TPGTargetAction): TPGActionResult; virtual;
function IndexOfTarget(Const Target: TCompileTarget): Integer; virtual; abstract;
function IndexOfTarget(Const AFilename: String): Integer; virtual;
function IndexOfRemovedTarget(Const Target: TCompileTarget): Integer; virtual; abstract;
@ -133,22 +133,22 @@ var
ProjectGroupManager: TProjectGroupManager = nil;
const
TargetActions: array[TTargetType] of TTargetActions = (
PGTargetActions: array[TPGTargetType] of TPGTargetActions = (
[], // ttUnknown
[taOpen,taSettings,taCompile,taCompileClean,taRun], // ttProject
[taOpen,taSettings,taCompile,taCompileClean,taInstall,taUninstall], // ttPackage
[taOpen,taCompile,taCompileClean], // ttProjectGroup
[taOpen,taCompile], // ttUnit
[taOpen,taCompile,taRun], // ttFile
[taOpen,taRun] // ttExternalTool
);
function TargetTypeFromExtenstion(AExt: String): TTargetType;
function TargetSupportsAction(ATarget: TTargetType; AAction: TTargetAction): Boolean;
function ActionAllowsMulti(AAction: TTargetAction): Boolean;
function TargetTypeFromExtenstion(AExt: String): TPGTargetType;
function TargetSupportsAction(ATarget: TPGTargetType; AAction: TPGTargetAction): Boolean;
function ActionAllowsMulti(AAction: TPGTargetAction): Boolean;
implementation
function TargetTypeFromExtenstion (AExt: String): TTargetType;
function TargetTypeFromExtenstion (AExt: String): TPGTargetType;
begin
while (AExt<>'') and (AExt[1]='.') do
Delete(AExt,1,1);
@ -159,19 +159,19 @@ begin
'lpg': Result:=ttProjectGroup;
'pas',
'pp',
'p' : Result:=ttUnit;
'p' : Result:=ttFile;
else
Result:=ttUnknown;
end;
end;
function TargetSupportsAction(ATarget: TTargetType; AAction: TTargetAction
function TargetSupportsAction(ATarget: TPGTargetType; AAction: TPGTargetAction
): Boolean;
begin
Result:=AAction in TargetActions[ATarget];
Result:=AAction in PGTargetActions[ATarget];
end;
function ActionAllowsMulti(AAction: TTargetAction): Boolean;
function ActionAllowsMulti(AAction: TPGTargetAction): Boolean;
begin
Result:=AAction in [taCompile,taCompileClean];
end;
@ -203,24 +203,24 @@ begin
FFileName:=AValue;
end;
function TProjectGroup.Perform(Index: Integer; AAction: TTargetAction
): TActionResult;
function TProjectGroup.Perform(Index: Integer; AAction: TPGTargetAction
): TPGActionResult;
begin
Result:=Perform(GetTarget(Index),AAction);
end;
function TProjectGroup.Perform(const AFileName: String; AAction: TTargetAction
): TActionResult;
function TProjectGroup.Perform(const AFileName: String; AAction: TPGTargetAction
): TPGActionResult;
begin
Result:=Perform(IndexOfTarget(AFileName),AAction);
end;
function TProjectGroup.Perform(Target: TCompileTarget; AAction: TTargetAction): TActionResult;
function TProjectGroup.Perform(Target: TCompileTarget; AAction: TPGTargetAction): TPGActionResult;
begin
Result:=Target.Perform(AAction);
end;
function TProjectGroup.ActionAllowsFrom(Index: Integer; AAction: TTargetAction
function TProjectGroup.ActionAllowsFrom(Index: Integer; AAction: TPGTargetAction
): Boolean;
Var
C: Integer;
@ -237,8 +237,8 @@ begin
end;
end;
function TProjectGroup.PerformFrom(AIndex: Integer; AAction: TTargetAction
): TActionResult;
function TProjectGroup.PerformFrom(AIndex: Integer; AAction: TPGTargetAction
): TPGActionResult;
Var
I: Integer;
begin
@ -303,12 +303,12 @@ end;
{ TCompileTarget }
function TCompileTarget.GetAllowedActions: TTargetActions;
function TCompileTarget.GetAllowedActions: TPGTargetActions;
begin
Result:=TargetActions[TargetType];
Result:=PGTargetActions[TargetType];
end;
procedure TCompileTarget.SetTargetType(AValue: TTargetType);
procedure TCompileTarget.SetTargetType(AValue: TPGTargetType);
begin
if FTargetType=AValue then Exit;
FTargetType:=AValue;
@ -339,7 +339,7 @@ begin
FActive:=False;
end;
function TCompileTarget.Perform(AAction: TTargetAction): TActionResult;
function TCompileTarget.Perform(AAction: TPGTargetAction): TPGActionResult;
begin
if Not (AAction in AllowedActions) then
Result:=arNotAllowed