projectgroups: menu item add existing, menu item add new group, more dropdown style, patch #35836 from Ondrej

git-svn-id: trunk@61576 -

components/projectgroups/projectgroupeditor.lfm

@@ -1,7 +1,7 @@
 object ProjectGroupEditorForm: TProjectGroupEditorForm
-  Left = 383
+  Left = 190
   Height = 358
-  Top = 187
+  Top = 198
   Width = 646
   Caption = 'ProjectGroupEditorForm'
   ClientHeight = 358
@@ -28,70 +28,73 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
       Action = AProjectGroupSave
     end
     object TBAdd: TToolButton
-      Left = 106
+      Left = 102
       Top = 2
-      Action = AProjectGroupAddExisting
+      Caption = 'Add'
+      DropdownMenu = PopupMenuAdd
+      ImageIndex = 8
+      Style = tbsButtonDrop
     end
     object TBNewTarget: TToolButton
-      Left = 34
+      Left = 33
       Top = 2
       Action = AProjectGroupAddNew
       Visible = False
     end
     object TBDelete: TToolButton
-      Left = 136
+      Left = 142
       Top = 2
       Action = AProjectGroupDelete
     end
     object TBCompile: TToolButton
-      Left = 189
+      Left = 193
       Top = 2
       Action = ATargetCompile
     end
     object TBCompileClean: TToolButton
-      Left = 241
+      Left = 246
       Top = 2
       Action = ATargetCompileClean
     end
     object ToolButton1: TToolButton
-      Left = 326
+      Left = 332
       Height = 46
       Top = 2
       Caption = 'ToolButton1'
       Style = tbsSeparator
     end
     object TBTargetUp: TToolButton
-      Left = 388
+      Left = 391
       Top = 2
       Action = ATargetEarlier
     end
     object TBTargetLater: TToolButton
-      Left = 432
+      Left = 431
       Top = 2
       Action = ATargetLater
     end
     object TBMore: TToolButton
-      Left = 515
+      Left = 509
       Top = 2
       Caption = 'More...'
       DropdownMenu = PopupMenuMore
-      Style = tbsDropDown
+      Style = tbsButtonDrop
     end
     object TBActivate: TToolButton
-      Left = 334
+      Left = 340
       Top = 2
       Action = ATargetActivate
       Visible = False
     end
     object TBReload: TToolButton
-      Left = 469
+      Left = 465
       Top = 2
       Action = AProjectGroupReload
     end
   end
   object TVPG: TTreeView
     Left = 0
-    Height = 291
+    Height = 287
     Top = 48
     Width = 646
     Align = alClient
@@ -110,8 +113,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
   end
   object SBPG: TStatusBar
     Left = 0
-    Height = 19
-    Top = 339
+    Height = 23
+    Top = 335
     Width = 646
     Panels = <    
       item
@@ -125,8 +128,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
     SimplePanel = False
   end
   object ImageListMain: TImageList
-    left = 128
-    top = 184
+    Left = 128
+    Top = 184
     Bitmap = {
       4C691A0000001000000010000000FFFFFF009E6E4D2B9D6D4CD69D6D4BC59D6C
       4BFF9C6C4AFF9C6B49FF9B6A49FF9B6A48FF9A6947FF996846FF986745FF9364
@@ -966,8 +969,11 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
   object PopupMenuMore: TPopupMenu
     Images = ImageListMain
     OnPopup = PopupMenuMorePopup
-    left = 208
-    top = 96
+    Left = 208
+    Top = 96
+    object PMINew: TMenuItem
+      Action = AProjectGroupNew
+    end
     object PMISaveAs: TMenuItem
       Action = AProjectGroupSaveAs
     end
@@ -986,8 +992,8 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
   end
   object ActionListMain: TActionList
     Images = ImageListMain
-    left = 48
-    top = 152
+    Left = 48
+    Top = 152
     object AProjectGroupSave: TAction
       Category = 'ProjectGroupActions'
       Caption = 'Save'
@@ -1004,21 +1010,10 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
     end
     object AProjectGroupAddExisting: TAction
       Category = 'ProjectGroupActions'
-      Caption = 'Add'
+      Caption = 'Add from file'
       ImageIndex = 8
       OnExecute = AProjectGroupAddExistingExecute
-    end
-    object AProjectGroupDelete: TAction
-      Category = 'ProjectGroupActions'
-      Caption = 'Remove'
-      ImageIndex = 9
-      OnExecute = AProjectGroupDeleteExecute
-      OnUpdate = AProjectGroupDeleteUpdate
-    end
-    object AProjectGroupAddNew: TAction
-      Category = 'ProjectGroupActions'
-      Caption = 'New Target'
-      ImageIndex = 6
+      OnUpdate = AProjectGroupAddExistingUpdate
     end
     object ATargetEarlier: TAction
       Category = 'TargetAction'
@@ -1099,11 +1094,37 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
       OnExecute = ATargetCopyFilenameExecute
       OnUpdate = ATargetCopyFilenameUpdate
     end
+    object ATargetInfo: TAction
+      Category = 'TargetAction'
+      Caption = 'Info'
+      OnExecute = ATargetInfoExecute
+      OnUpdate = ATargetInfoUpdate
+    end
+    object AProjectGroupAddCurrent: TAction
+      Category = 'ProjectGroupActions'
+      Caption = 'Add current project'
+      ImageIndex = 8
+      OnExecute = AProjectGroupAddCurrentExecute
+      OnUpdate = AProjectGroupAddCurrentUpdate
+    end
+    object AProjectGroupDelete: TAction
+      Category = 'ProjectGroupActions'
+      Caption = 'Remove'
+      ImageIndex = 9
+      OnExecute = AProjectGroupDeleteExecute
+      OnUpdate = AProjectGroupDeleteUpdate
+    end
+    object AProjectGroupAddNew: TAction
+      Category = 'ProjectGroupActions'
+      Caption = 'New Target'
+      ImageIndex = 6
+    end
     object AProjectGroupReload: TAction
       Category = 'ProjectGroupActions'
       Caption = 'Reload'
       ImageIndex = 25
       OnExecute = AProjectGroupReloadExecute
+      OnUpdate = AProjectGroupAddExistingUpdate
     end
     object AProjectGroupUndo: TAction
       Category = 'ProjectGroupActions'
@@ -1122,17 +1143,16 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
       Caption = 'Options'
       OnExecute = AProjectGroupOptionsExecute
     end
-    object ATargetInfo: TAction
-      Category = 'TargetAction'
-      Caption = 'Info'
-      OnExecute = ATargetInfoExecute
-      OnUpdate = ATargetInfoUpdate
+    object AProjectGroupNew: TAction
+      Category = 'ProjectGroupActions'
+      Caption = 'New project group'
+      OnExecute = AProjectGroupNewExecute
     end
   end
   object PopupMenuTree: TPopupMenu
     Images = ImageListMain
-    left = 208
-    top = 152
+    Left = 208
+    Top = 152
     object PMICopyFilenameMenuItem: TMenuItem
       Action = ATargetCopyFilename
     end
@@ -1166,7 +1186,17 @@ object ProjectGroupEditorForm: TProjectGroupEditorForm
   end
   object OpenDialogTarget: TOpenDialog
     Options = [ofAllowMultiSelect, ofFileMustExist, ofEnableSizing, ofViewDetail]
-    left = 48
-    top = 96
+    Left = 48
+    Top = 96
+  end
+  object PopupMenuAdd: TPopupMenu
+    Left = 120
+    Top = 53
+    object PMIAddExisting: TMenuItem
+      Action = AProjectGroupAddExisting
+    end
+    object PMIAddCurrent: TMenuItem
+      Action = AProjectGroupAddCurrent
+    end
   end
 end

components/projectgroups/projectgroupeditor.pas

@@ -47,6 +47,8 @@ type
   { TProjectGroupEditorForm }
 
   TProjectGroupEditorForm = class(TForm)
+    AProjectGroupNew: TAction;
+    AProjectGroupAddCurrent: TAction;
     ATargetInfo: TAction;
     AProjectGroupOptions: TAction;
     AProjectGroupRedo: TAction;
@@ -71,6 +73,9 @@ type
     AProjectGroupSave: TAction;
     ActionListMain: TActionList;
     ImageListMain: TImageList;
+    PMINew: TMenuItem;
+    PMIAddExisting: TMenuItem;
+    PMIAddCurrent: TMenuItem;
     PMIInfo: TMenuItem;
     PMIOptions: TMenuItem;
     PMIRedo: TMenuItem;
@@ -87,6 +92,7 @@ type
     PMICompileClean: TMenuItem;
     PMICompile: TMenuItem;
     OpenDialogTarget: TOpenDialog;
+    PopupMenuAdd: TPopupMenu;
     PopupMenuMore: TPopupMenu;
     PopupMenuTree: TPopupMenu;
     SBPG: TStatusBar;
@@ -104,9 +110,13 @@ type
     TBActivate: TToolButton;
     TBReload: TToolButton;
     TVPG: TTreeView;
+    procedure AProjectGroupAddCurrentExecute(Sender: TObject);
+    procedure AProjectGroupAddCurrentUpdate(Sender: TObject);
     procedure AProjectGroupAddExistingExecute(Sender: TObject);
+    procedure AProjectGroupAddExistingUpdate(Sender: TObject);
     procedure AProjectGroupDeleteExecute(Sender: TObject);
     procedure AProjectGroupDeleteUpdate(Sender: TObject);
+    procedure AProjectGroupNewExecute(Sender: TObject);
     procedure AProjectGroupOptionsExecute(Sender: TObject);
     procedure AProjectGroupRedoExecute(Sender: TObject);
     procedure AProjectGroupRedoUpdate(Sender: TObject);
@@ -201,12 +211,14 @@ type
     function CreateSectionNode(AParent: TTreeNode; Const ACaption: String; ANodeType: TNodeType): TTreeNode;
     function CreateTargetNode(AParent: TTreeNode; ANodeType: TNodeType; aTarget: TPGCompileTarget): TTreeNode;
     function CreateSubNode(AParent: TTreeNode; ANodeType: TNodeType; aParentTarget: TPGCompileTarget; aValue: string): TTreeNode;
+    procedure ClearNodeData(TVNode: TTreeNode);
     procedure ClearChildNodes(TVNode: TTreeNode);
     procedure FillPackageNode(TVNode: TTreeNode; T: TPGCompileTarget);
     procedure FillProjectNode(TVNode: TTreeNode; T: TPGCompileTarget);
     procedure FillTargetNode(TVNode: TTreeNode; T: TPGCompileTarget);
     procedure FillProjectGroupNode(TVNode: TTreeNode; AProjectGroup: TProjectGroup);
     function GetNodeImageIndex(ANodeType: TNodeType; ANodeData: TPGCompileTarget ): Integer;
+    procedure AddTarget(const aFileName: string);
     function SelectedNodeData: TNodeData;
     function SelectedTarget: TPGCompileTarget;
     function GetTVNodeFilename(TVNode: TTreeNode): string;
@@ -269,7 +281,9 @@ var
   // Action image indexes
   iiProjectGroupSave         : Integer = -1;
   iiProjectGroupSaveAs       : Integer = -1;
+  iiProjectGroupNew          : Integer = -1;
   iiProjectGroupAddExisting  : Integer = -1;
+  iiProjectGroupAddCurrent   : Integer = -1;
   iiProjectGroupDelete       : Integer = -1;
   iiProjectGroupAddNew       : Integer = -1;
   iiTargetEarlier            : Integer = -1;
@@ -336,6 +350,15 @@ begin
   PG.OnTargetsExchanged:=Nil;
 end;
 
+procedure TProjectGroupEditorForm.ClearNodeData(TVNode: TTreeNode);
+begin
+  if TVNode.Data<>nil then
+  begin
+    TObject(TVNode.Data).Free;
+    TVNode.Data:=nil;
+  end;
+end;
+
 procedure TProjectGroupEditorForm.SetBuildCommandRedirected(
   const AValue: boolean);
 var
@@ -411,7 +434,9 @@ procedure TProjectGroupEditorForm.Localize;
 begin
   ConfigAction(AProjectGroupSave,iiProjectGroupSave,lisProjectGroupSaveCaption,lisProjectGroupSaveHint,Nil);
   ConfigAction(AProjectGroupSaveAs,iiProjectGroupSaveAs,lisProjectGroupSaveAsCaption,lisProjectGroupSaveAsHint,Nil);
+  ConfigAction(AProjectGroupNew,iiProjectGroupNew,lisProjectGroupNewCaption,lisProjectGroupNewHint,Nil);
   ConfigAction(AProjectGroupAddExisting,iiProjectGroupAddExisting,lisProjectGroupAddExistingCaption,lisProjectGroupAddExistingHint,Nil);
+  ConfigAction(AProjectGroupAddCurrent,iiProjectGroupAddCurrent,lisProjectGroupAddCurrentProjectCaption,lisProjectGroupAddCurrentProjectHint,Nil);
   ConfigAction(AProjectGroupDelete,iiProjectGroupDelete,lisProjectGroupDeleteCaption,lisProjectGroupDeleteHint,Nil);
   ConfigAction(AProjectGroupAddNew,iiProjectGroupAddNew,lisProjectGroupAddNewCaption,lisProjectGroupAddNewHint,Nil);
   ConfigAction(ATargetEarlier,iiTargetEarlier,lisTargetEarlierCaption,lisTargetEarlierHint,Nil);
@@ -431,12 +456,15 @@ begin
   ConfigAction(AProjectGroupRedo, 0, lisRedo, '', nil);
   ConfigAction(AProjectGroupOptions, 0, lisOptions, '', nil);
   TBMore.Caption:=lisMore;
+  TBAdd.Caption := lisProjectGroupAddCaption;
+  TBAdd.Hint := lisProjectGroupAddHint;
 end;
 
 procedure TProjectGroupEditorForm.AProjectGroupSaveUpdate(Sender: TObject);
 begin
   (Sender as TAction).Enabled:=(FProjectGroup<>nil)
     and (FProjectGroup.Modified or (FProjectGroup.FileName=''));
+  TBAdd.Enabled:=(FProjectGroup<>nil);
   UpdateIDEMenuCommandFromAction(Sender,MnuCmdSaveProjectGroup);
 end;
 
@@ -787,6 +815,8 @@ begin
   N:=FindTVNodeOfTarget(Target);
   TVPG.BeginUpdate;
   try
+    ClearChildNodes(N);
+    ClearNodeData(N);
     TVPG.Items.Delete(N);
     TVPG.Selected:=FProjectGroupTVNode;
   finally
@@ -842,35 +872,28 @@ end;
 
 procedure TProjectGroupEditorForm.AProjectGroupAddExistingExecute(Sender: TObject);
 var
-  aTarget: TIDECompileTarget;
-  aMode: TPGBuildMode;
-  TVNode: TTreeNode;
   i: Integer;
 begin
   if FProjectGroup=nil then exit;
-  aTarget:=TIDECompileTarget(SelectedTarget);
   InitIDEFileDialog(OpenDialogTarget);
-  OpenDialogTarget.Filter := lisLazarusProjectsLpi + '|*.lpi'
+  OpenDialogTarget.Filter :=
+           lisLazarusSupportedInProjectGroups + '|*.lpi;*.lpk;*.lpg;*.pas;*.pp;*.p'
+   + '|' + lisLazarusProjectsLpi + '|*.lpi'
    + '|' + lisLazarusPackagesLpk + '|*.lpk'
    + '|' + lisLazarusProjectGroupsLpg + '|*.lpg'
    + '|' + lisPascalFilePasPpP + '|*.pas;*.pp;*.p';
   If OpenDialogTarget.Execute then
     for i:=0 to OpenDialogTarget.Files.Count-1 do
-    begin
-      aTarget:=FProjectGroup.AddTarget(OpenDialogTarget.Files[i]) as TIDECompileTarget;
-      aTarget.LoadTarget(true);
-      if aTarget.BuildModeCount>1 then
-      begin
-        aMode:=aTarget.BuildModes[0];
-        aMode.Compile:=true;
-        // ToDo: implement changed notification
-        TVNode:=FindTVNodeOfBuildMode(aMode);
-        TVNode.StateIndex:=NSIChecked;
-      end;
-    end;
+      AddTarget(OpenDialogTarget.Files[i]);
   StoreIDEFileDialog(OpenDialogTarget);
 end;
 
+procedure TProjectGroupEditorForm.AProjectGroupAddExistingUpdate(
+  Sender: TObject);
+begin
+  (Sender as TAction).Enabled:=FProjectGroup<>nil;
+end;
+
 procedure TProjectGroupEditorForm.ATargetActivateUpdate(Sender: TObject);
 Var
   T: TPGCompileTarget;
@@ -955,6 +978,40 @@ begin
     AAction.Enabled:=Result;
 end;
 
+procedure TProjectGroupEditorForm.AProjectGroupAddCurrentExecute(
+  Sender: TObject);
+begin
+  if LazarusIDE.ActiveProject.ProjectInfoFile<>'' then
+    AddTarget(LazarusIDE.ActiveProject.ProjectInfoFile);
+end;
+
+procedure TProjectGroupEditorForm.AProjectGroupAddCurrentUpdate(
+  Sender: TObject);
+begin
+  (Sender as TAction).Enabled := (FProjectGroup<>nil) and (LazarusIDE.ActiveProject<>nil)
+    and (LazarusIDE.ActiveProject.ProjectInfoFile<>'');
+end;
+
+procedure TProjectGroupEditorForm.AddTarget(const aFileName: string);
+var
+  aTarget: TIDECompileTarget;
+  aMode: TPGBuildMode;
+  TVNode: TTreeNode;
+begin
+  if FProjectGroup.IndexOfTarget(aFileName)>=0 then
+    Exit;
+  aTarget:=FProjectGroup.AddTarget(aFileName) as TIDECompileTarget;
+  aTarget.LoadTarget(true);
+  if aTarget.BuildModeCount>1 then
+  begin
+    aMode:=aTarget.BuildModes[0];
+    aMode.Compile:=true;
+    // ToDo: implement changed notification
+    TVNode:=FindTVNodeOfBuildMode(aMode);
+    TVNode.StateIndex:=NSIChecked;
+  end;
+end;
+
 procedure TProjectGroupEditorForm.Perform(ATargetAction: TPGTargetAction);
 Var
   ND: TNodeData;
@@ -1015,6 +1072,11 @@ begin
   UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetRemove);
 end;
 
+procedure TProjectGroupEditorForm.AProjectGroupNewExecute(Sender: TObject);
+begin
+  IDEProjectGroupManager.DoNewClick(Sender);
+end;
+
 procedure TProjectGroupEditorForm.AProjectGroupOptionsExecute(Sender: TObject);
 begin
   LazarusIDE.DoOpenIDEOptions(TProjGrpOptionsFrame);
@@ -1413,11 +1475,7 @@ procedure TProjectGroupEditorForm.ClearChildNodes(TVNode: TTreeNode);
     for i:=0 to aTVNode.Count-1 do
     begin
       ChildNode:=aTVNode[i];
-      if ChildNode.Data<>nil then
-      begin
-        TObject(ChildNode.Data).Free;
-        ChildNode.Data:=nil;
-      end;
+      ClearNodeData(ChildNode);
       FreeChildrenNodeData(ChildNode);
     end;
   end;

components/projectgroups/projectgroupstrconst.pas

@@ -65,8 +65,14 @@ Resourcestring
   lisProjectGroupSaveHint      = 'Save project group';
   lisProjectGroupSaveAsCaption = 'Save As ...';
   lisProjectGroupSaveAsHint    = 'Save project group with a new name';
-  lisProjectGroupAddExistingCaption = 'Add';
+  lisProjectGroupNewCaption = 'New';
+  lisProjectGroupNewHint    = 'New project group';
+  lisProjectGroupAddCaption = 'Add';
+  lisProjectGroupAddHint    = 'Add targets to project group';
+  lisProjectGroupAddExistingCaption = 'Add from file';
   lisProjectGroupAddExistingHint    = 'Add existing target to project group';
+  lisProjectGroupAddCurrentProjectCaption = 'Add current project';
+  lisProjectGroupAddCurrentProjectHint    = 'Add current project to project group';
   lisProjectGroupDeleteCaption = 'Remove';
   lisProjectGroupDeleteHint    = 'Remove target from project group';
   lisProjectGroupAddNewCaption = 'New';
@@ -116,6 +122,7 @@ Resourcestring
   lisPackageNotFound = 'Package not found';
   lisPackageNotFound2 = 'Package "%s" not found.';
   lisBuildMode2 = 'Build Mode "%s"';
+  lisLazarusSupportedInProjectGroups = 'Lazarus files (*.lpi;*.lpk;*.lpg;*.pas;*.pp;*.p)';
   lisLazarusProjectsLpi = 'Lazarus projects (*.lpi)';
   lisLazarusPackagesLpk = 'Lazarus packages (*.lpk)';
   lisLazarusProjectGroupsLpg = 'Lazarus project groups (*.lpg)';