{ Todo: - close windows on IDE close - activate project when project is opened - deactivate project when project is closed - make dockable } unit ProjectGroupEditor; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus, ActnList, LCLProc, LazIDEIntf, PackageIntf, ProjectIntf, ProjectGroupIntf, MenuIntf, IDEDialogs, IDEWindowIntf, LazFileUtils, LazLogger, ProjectGroupStrConst, ProjectGroup; type TNodeType = (ntUnknown, ntProjectGroup, ntTargets, ntRemovedTargets, ntTarget, ntRemovedTarget, ntFiles, ntFile, ntRemovedFiles, ntRemovedFile, ntDependencies, ntDependency, ntRemovedDependencies, ntRemovedDependency); TNodeData = class(TObject) NodeType: TNodeType; Target: TCompileTarget; ProjectGroup: TProjectGroup; // projectgroup to which target belongs end; TTargetNodes = Array[Boolean] of TTreeNode; { TProjectGroupEditorForm } TProjectGroupEditorForm = class(TForm) AProjectGroupAddExisting: TAction; ATargetCompile: TAction; ATargetCompileClean: TAction; AProjectGroupAddNew: TAction; ATargetActivate: TAction; ATargetOpen: TAction; AProjectGroupSaveAs: TAction; ATargetUninstall: TAction; ATargetInstall: TAction; ATargetRun: TAction; ATargetProperties: TAction; ATargetLater: TAction; ATargetEarlier: TAction; AProjectGroupDelete: TAction; AProjectGroupSave: TAction; ActionListMain: TActionList; ImageListMain: TImageList; PMIOPen: TMenuItem; PMISaveAs: TMenuItem; PMIProperties: TMenuItem; PMILater: TMenuItem; PMIEarlier: TMenuItem; PMIDelete: TMenuItem; PMICompileClean: TMenuItem; PMICompile: TMenuItem; OpenDialogTarget: TOpenDialog; PopupMenuMore: TPopupMenu; PopupMenuTree: TPopupMenu; SaveDialogPG: TSaveDialog; SBPG: TStatusBar; TBProjectGroup: TToolBar; TBSave: TToolButton; TBAdd: TToolButton; TBNewTarget: TToolButton; TBDelete: TToolButton; TBCompile: TToolButton; TBCompileClean: TToolButton; ToolButton1: TToolButton; TBTargetUp: TToolButton; TBTargetLater: TToolButton; TBMore: TToolButton; TBActivate: TToolButton; TVPG: TTreeView; procedure ATargetActivateExecute(Sender: TObject); procedure ATargetActivateUpdate(Sender: TObject); procedure AProjectGroupAddExistingExecute(Sender: TObject); procedure ATargetCompileCleanExecute(Sender: TObject); procedure ATargetCompileCleanUpdate(Sender: TObject); procedure ATargetCompileExecute(Sender: TObject); procedure ATargetCompileUpdate(Sender: TObject); procedure AProjectGroupDeleteExecute(Sender: TObject); procedure AProjectGroupDeleteUpdate(Sender: TObject); procedure ATargetInstallExecute(Sender: TObject); procedure ATargetInstallUpdate(Sender: TObject); procedure ATargetOpenExecute(Sender: TObject); procedure ATargetOpenUpdate(Sender: TObject); procedure ATargetPropertiesExecute(Sender: TObject); procedure ATargetPropertiesUpdate(Sender: TObject); procedure ATargetRunExecute(Sender: TObject); procedure ATargetRunUpdate(Sender: TObject); procedure AProjectGroupSaveAsExecute(Sender: TObject); procedure AProjectGroupSaveExecute(Sender: TObject); procedure AProjectGroupSaveUpdate(Sender: TObject); procedure ATargetEarlierExecute(Sender: TObject); procedure ATargetEarlierUpdate(Sender: TObject); procedure ATargetLaterExecute(Sender: TObject); procedure ATargetLaterUpdate(Sender: TObject); procedure ATargetUninstallExecute(Sender: TObject); procedure ATargetUninstallUpdate(Sender: TObject); procedure DoFileNameChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure TVPGDblClick(Sender: TObject); private FProjectGroup: TProjectGroup; FProjectGroupTarget: TCompileTarget; FNPG: TTreeNode; FActiveTarget: TCompileTarget; FTargetNodes: TTargetNodes; // Project group callbacks procedure ConfigNode(Node: TTreeNode; Const ACaption: String; ANodeData: TNodeData); procedure DoTargetAdded(Sender: TObject; Target: TCompileTarget); procedure DoTargetDeleted(Sender: TObject; Target: TCompileTarget); procedure DoTargetActivated(Sender: TObject; Target: TCompileTarget); procedure DoTargetExchanged(Sender: TObject; Target1, Target2: TCompileTarget); 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: TPGTargetAction); function GetActiveTarget: TCompileTarget; // Treeview Node management function FindNodeFromTarget(ATarget: TCompileTarget): TTreeNode; procedure FreeNodeData; class function TargetFromNode(N: TTreeNode): TCompileTarget; function DisplayFileName(AProjectGroup: TProjectGroup;NodeType: TNodeType; AFileName: String): String; function CreateNode(AParent: TTreeNode; Const ACaption: String; ANodeType: TNodeType; ANodeData: TCompileTarget; AProjectGroup: TProjectGroup): TTreeNode; procedure FillPackageNode(AParent: TTreeNode; AProjectGroup: TProjectGroup; T: TIDEPackage); procedure FillProjectNode(AParent: TTreeNode; AProjectGroup: TProjectGroup; T: TLazProject); procedure FillTargetNode(AParent: TTreeNode; AProjectGroup: TProjectGroup; T: TCompileTarget); procedure FillProjectGroupNode(AParent: TTreeNode; AProjectGroup: TProjectGroup; Out TargetNodes: TTargetNodes); function GetNodeIndex(ANodeType: TNodeType; ANodeData: TCompileTarget ): Integer; function SelectedNodeData: TNodeData; function SelectedTarget: TCompileTarget; function SelectedNodeType: TCompileTarget; procedure UpdateIDEMenuCommandFromAction(Sender: TObject; Item: TIDEMenuCommand); protected procedure Localize; procedure ShowProjectGroup; procedure UpdateShowing; override; public property ProjectGroup: TProjectGroup Read FProjectGroup Write SetProjectGroup; property ActiveTarget: TCompileTarget Read GetActiveTarget; end; var ProjectGroupEditorForm: TProjectGroupEditorForm; ProjectGroupEditorCreator: TIDEWindowCreator; // set by RegProjectGroup.Register const ProjectGroupEditorName = 'ProjectGroupEditor'; procedure ShowProjectGroupEditor(Sender: TObject; AProjectGroup: TProjectGroup); procedure CreateProjectGroupEditor(Sender: TObject; aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: boolean); procedure SetProjectGroupEditorCallBack; implementation {$R *.lfm} var // Nodelist image indexes NIProjectGroup : integer = 0; NITargets : integer = 1; NIRemovedTargerts : integer = 2; NITargetProject : integer = 3; NITargetPackage : integer = 4; NITargetProjectGroup : integer = 5; NIRemovedTargetProject : integer = 3; NIRemovedTargetPackage : integer = 4; NIRemovedTargetProjectGroup: integer = 5; NIFiles : integer = 16; NIFile : integer = 17; NIRemovedFiles : integer = 18; NIRemovedFile : integer = 17; NIDependencies : integer = 1; NIDependency : integer = 1; NIRemovedDependencies : integer = 2; NIRemovedDependency : integer = 2; // Node state image index NSIActive : Integer = 20; // State index for active. // Action image indexes iiProjectGroupSave : Integer = -1; iiProjectGroupSaveAs : Integer = -1; iiProjectGroupAddExisting : Integer = -1; iiProjectGroupDelete : Integer = -1; iiProjectGroupAddNew : Integer = -1; iiTargetEarlier : Integer = -1; iiTargetLater : Integer = -1; iiTargetCompile : Integer = -1; iiTargetCompileClean : Integer = -1; iiTargetProperties : Integer = -1; iiTargetRun : Integer = -1; iiTargetInstall : Integer = -1; iiTargetUninstall : Integer = -1; iiTargetActivate : Integer = -1; iiTargetOpen : Integer = -1; const // Status bar Panel indexes piTargetCount = 0; piActiveTarget = 1; procedure ShowProjectGroupEditor(Sender: TObject; AProjectGroup: TProjectGroup); begin IDEWindowCreators.ShowForm(ProjectGroupEditorCreator.FormName,true); if AProjectGroup<>nil then ProjectGroupEditorForm.ProjectGroup:=AProjectGroup; end; procedure CreateProjectGroupEditor(Sender: TObject; aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: boolean); begin if CompareText(aFormName,ProjectGroupEditorName)<>0 then begin DebugLn(['ERROR: CreateProjectGroupEditor: there is already a form with this name']); exit; end; IDEWindowCreators.CreateForm(AForm,TProjectGroupEditorForm,DoDisableAutoSizing, LazarusIDE.OwningComponent); AForm.Name:=aFormName; end; procedure SetProjectGroupEditorCallBack; begin ProjectGroupEditorCreator:=IDEWindowCreators.Add(ProjectGroupEditorName, @CreateProjectGroupEditor,nil, '30%','30%','+30%','+40%','ProjectGroupEditor',alNone); OnShowProjectGroupEditor:=@ShowProjectGroupEditor; end; { TProjectGroupEditorForm } procedure TProjectGroupEditorForm.ClearEventCallBacks(AProjectGroup: TProjectGroup); Var PG: TIDEProjectGroup; begin if AProjectGroup is TIDEProjectGroup then PG:=TIDEProjectGroup(AProjectGroup) else exit; PG.OnFileNameChange:=Nil; PG.OnTargetAdded:=Nil; PG.OnTargetDeleted:=Nil; PG.OnTargetActivated:=Nil; PG.OnTargetsExchanged:=Nil; end; procedure TProjectGroupEditorForm.SetEventCallBacks(AProjectGroup: TProjectGroup); Var PG: TIDEProjectGroup; begin if AProjectGroup is TIDEProjectGroup then PG:=TIDEProjectGroup(AProjectGroup) else exit; PG.OnFileNameChange:=@DoFileNameChange; PG.OnTargetAdded:=@DoTargetAdded; PG.OnTargetDeleted:=@DoTargetDeleted; PG.OnTargetActivated:=@DoTargetActivated; PG.OnTargetsExchanged:=@DoTargetExchanged; end; procedure TProjectGroupEditorForm.SetProjectGroup(AValue: TProjectGroup); begin if FProjectGroup=AValue then Exit; if ProjectGroup<>nil then begin ClearEventCallBacks(ProjectGroup); end; FreeAndNil(FProjectGroupTarget); FProjectGroup:=AValue; if ProjectGroup<>nil then begin SetEventCallBacks(ProjectGroup); FProjectGroupTarget:=TProjectGroupTarget.Create(AValue); end; FActiveTarget:=Nil; ShowProjectGroup; end; procedure TProjectGroupEditorForm.Localize; procedure ConfigAction(A: TAction; AImageIndex: Integer; Const ACaption,AHint: String; Mnu: TIDEMenuCommand); begin A.Caption:=ACaption; A.Hint:=AHint; if AImageIndex<>-1 then A.ImageIndex:=AImageIndex; If Assigned(mnu) then Mnu.OnClick:=A.OnExecute; // ToDo Enabled and visible don't play well with actions... end; begin ConfigAction(AProjectGroupSave,iiProjectGroupSave,lisProjectGroupSaveCaption,lisProjectGroupSaveHint,Nil); ConfigAction(AProjectGroupSaveAs,iiProjectGroupSaveAs,lisProjectGroupSaveAsCaption,lisProjectGroupSaveAsHint,Nil); ConfigAction(AProjectGroupAddExisting,iiProjectGroupAddExisting,lisProjectGroupAddExistingCaption,lisProjectGroupAddExistingHint,Nil); ConfigAction(AProjectGroupDelete,iiProjectGroupDelete,lisProjectGroupDeleteCaption,lisProjectGroupDeleteHint,Nil); ConfigAction(AProjectGroupAddNew,iiProjectGroupAddNew,lisProjectGroupAddNewCaption,lisProjectGroupAddNewHint,Nil); ConfigAction(ATargetEarlier,iiTargetEarlier,lisTargetEarlierCaption,lisTargetEarlierHint,Nil); ConfigAction(ATargetLater,iiTargetLater,lisTargetLaterCaption,lisTargetLaterHint,Nil); ConfigAction(ATargetCompile,iiTargetCompile,lisTargetCompileCaption,lisTargetCompileHint,Nil); ConfigAction(ATargetCompileClean,iiTargetCompileClean,lisTargetCompileCleanCaption,lisTargetCompileCleanHint,Nil); ConfigAction(ATargetProperties,iiTargetProperties,lisTargetPropertiesCaption,lisTargetPropertiesHint,Nil); ConfigAction(ATargetRun,iiTargetRun,lisTargetRunCaption,lisTargetRunHint,Nil); ConfigAction(ATargetInstall,iiTargetInstall,lisTargetInstallCaption,lisTargetInstallHint,Nil); ConfigAction(ATargetUninstall,iiTargetUninstall,lisTargetUninstallCaption,lisTargetUninstallHint,Nil); ConfigAction(ATargetActivate,iiTargetActivate,lisTargetActivateCaption,lisTargetActivateHint,Nil); ConfigAction(ATargetOpen,iiTargetOpen,lisTargetOpenCaption,lisTargetOpenHint,Nil); end; procedure TProjectGroupEditorForm.AProjectGroupSaveUpdate(Sender: TObject); begin (Sender as TAction).Enabled:=FProjectGroup.Modified or (FProjectGroup.FileName=''); UpdateIDEMenuCommandFromAction(Sender,cmdSaveProjectGroup); end; procedure TProjectGroupEditorForm.ATargetEarlierExecute(Sender: TObject); Var T: TNodeData; I,J: Integer; begin T:=SelectedNodeData; If not Assigned(T) then exit; I:=T.ProjectGroup.IndexOfTarget(T.Target); J:=I-1; // Find previous not removed target While (J>=0) and (T.ProjectGroup.Targets[J].Removed) do Dec(J); if J>=0 then T.ProjectGroup.ExchangeTargets(I,J); end; procedure TProjectGroupEditorForm.ATargetEarlierUpdate(Sender: TObject); Var T: TNodeData; I: Integer; B: Boolean; begin I:=-1; T:=SelectedNodeData; B:=Assigned(T) and (T.NodeType=ntTarget) and Assigned(T.Target); If B then begin I:=T.ProjectGroup.IndexOfTarget(T.Target)-1; // Find previous not removed target While (I>=0) and (T.ProjectGroup.Targets[i].Removed) do Dec(I); B:=(I>=0) end; (Sender as TAction).Enabled:=B; UpdateIDEMenuCommandFromAction(Sender,cmdTargetEarlier); end; procedure TProjectGroupEditorForm.ATargetLaterExecute(Sender: TObject); Var T: TNodeData; I,J: Integer; begin T:=SelectedNodeData; If Not Assigned(T) then exit; I:=T.ProjectGroup.IndexOfTarget(T.Target); J:=I+1; // Find next not removed target While (JNil) and (T<>FProjectGroupTarget) and Not T.Removed; UpdateIDEMenuCommandFromAction(Sender,cmdTargetRemove); end; procedure TProjectGroupEditorForm.ATargetInstallExecute(Sender: TObject); begin Perform(taInstall); end; procedure TProjectGroupEditorForm.ATargetInstallUpdate(Sender: TObject); begin AllowPerform(taInstall,Sender as Taction); UpdateIDEMenuCommandFromAction(Sender,cmdTargetInstall); end; procedure TProjectGroupEditorForm.ATargetOpenExecute(Sender: TObject); begin Perform(taOpen); end; procedure TProjectGroupEditorForm.ATargetOpenUpdate(Sender: TObject); begin AllowPerform(taOpen,Sender as TAction); UpdateIDEMenuCommandFromAction(Sender,cmdTargetOpen); end; procedure TProjectGroupEditorForm.ATargetPropertiesExecute(Sender: TObject); begin Perform(taSettings); end; procedure TProjectGroupEditorForm.ATargetPropertiesUpdate(Sender: TObject); begin AllowPerform(taSettings,Sender as Taction); UpdateIDEMenuCommandFromAction(Sender,cmdTargetProperties); end; procedure TProjectGroupEditorForm.ATargetRunExecute(Sender: TObject); begin Perform(taRun); end; procedure TProjectGroupEditorForm.ATargetRunUpdate(Sender: TObject); begin AllowPerform(taRun,Sender as Taction); UpdateIDEMenuCommandFromAction(Sender,cmdTargetRun); end; procedure TProjectGroupEditorForm.AProjectGroupSaveAsExecute(Sender: TObject); begin IDEProjectGroupManager.DoSaveAsClick(Sender); end; procedure TProjectGroupEditorForm.FreeNodeData; Var N: TTreeNode; I: Integer; begin FNPG:=Nil; FTargetNodes[False]:=Nil; FTargetNodes[True]:=Nil; For I:=0 to TVPG.Items.Count-1 do begin N:=TVPG.Items[I]; TNodeData(N.Data).Free; // Would be nide to have a FreeAndNilData method in TTreeNode. N.Data:=Nil; end; end; function TProjectGroupEditorForm.GetNodeIndex(ANodeType: TNodeType; ANodeData: TCompileTarget): Integer; begin Case ANodeType of ntProjectGroup: Result:=NIProjectGroup; ntTargets: Result:=NITargets; ntRemovedTargets: Result:=NIRemovedTargerts; ntTarget : Case ANodeData.TargetType of ttProject: Result:=NITargetProject; ttPackage: Result:=NITargetPackage; ttProjectGroup: Result:=NITargetProjectGroup; end; ntRemovedTarget: Case ANodeData.TargetType of ttProject: Result:=NIRemovedTargetProject; ttPackage: Result:=NIRemovedTargetPackage; ttProjectGroup: Result:=NIRemovedTargetProjectGroup; end; ntFiles: Result:=NIFiles; ntFile: Result:=NIFile; ntRemovedFiles: Result:=NIRemovedFiles; ntRemovedFile: Result:=NIRemovedFile; ntDependencies: Result:=NIDependencies; ntDependency: Result:=NIDependency; ntRemovedDependencies: Result:=NIRemovedDependencies; ntRemovedDependency: Result:=NIRemovedDependency; else Result:=-1; end; end; function TProjectGroupEditorForm.SelectedNodeData: TNodeData; Var N: TTreeNode; begin N:=TVPG.Selected; If Assigned(N) then Result:=TNodeData(N.Data) else Result:=Nil; end; function TProjectGroupEditorForm.SelectedTarget: TCompileTarget; Var N: TNodeData; begin N:=SelectedNodeData; if Assigned(N) then Result:=N.Target else Result:=Nil; end; function TProjectGroupEditorForm.SelectedNodeType: TCompileTarget; Var N: TNodeData; begin N:=SelectedNodeData; if Assigned(N) then Result:=N.Target else Result:=Nil; end; procedure TProjectGroupEditorForm.ConfigNode(Node: TTreeNode; const ACaption: String; ANodeData: TNodeData); begin Node.Data:=ANodeData; If (ACaption<>'') then Node.Text:=ACaption; Node.ImageIndex:=GetNodeIndex(ANodeData.NodeType,ANodeData.Target); Node.SelectedIndex:=Node.ImageIndex; if Assigned(ANodeData.Target) and ANodeData.Target.Active then Node.StateIndex:=NSIActive else Node.StateIndex:=-1; end; function TProjectGroupEditorForm.CreateNode(AParent: TTreeNode; const ACaption: String; ANodeType: TNodeType; ANodeData: TCompileTarget; AProjectGroup: TProjectGroup): TTreeNode; Var ND: TNodeData; begin Result:=TVPG.Items.AddChild(AParent,ACaption); ND:=TNodeData.Create; ND.NodeType:=ANodeType; ND.ProjectGroup:=AProjectGroup; ND.Target:=ANodeData; ConfigNode(Result,'',ND); end; function TProjectGroupEditorForm.DisplayFileName(AProjectGroup: TProjectGroup;NodeType: TNodeType; AFileName: String): String; Var P: String; begin if Assigned(AProjectGroup) then P:=ExtractFilePath(AProjectGroup.FileName) else P:=''; if (P<>'') then Result:=ExtractRelativePath(P,AFileName) else Result:=AFileName; if not (NodeType in [ntFile, ntRemovedFile]) then Result:=ChangeFileExt(Result,''); end; procedure TProjectGroupEditorForm.ShowFileName; Var N: String; begin N:=FProjectGroup.FileName; if (N='') then Caption:=lisNewProjectGroup else Caption:=Format(LisProjectGroup,[DisplayFileName(FprojectGroup,ntProjectGroup,N)]); if Assigned(FNPG) then FNPG.Text:=DisplayFileName(FProjectGroup,ntProjectGroup,FProjectGroup.FileName); end; function TProjectGroupEditorForm.FindNodeFromTarget(ATarget: TCompileTarget): TTreeNode; Var I: Integer; begin I:=0; Result:=Nil; While (Result=Nil) and (INil) and (N.Data<>Nil) then Result:=TNodeData(N.Data).Target else Result:=Nil; end; end.