View Issue Details

IDProjectCategoryView StatusLast Update
0035836PackagesPackagespublic2019-07-12 15:37
ReporterOndrej PokornyAssigned ToMattias Gaertner 
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
Product VersionProduct Build 
Target VersionFixed in Version 
Summary0035836: Project groups: improvements in the ProjectGroupEditor
DescriptionThe attached patch fixes these small issues:
1.) If no project group is open, the "Add"+"Refresh" toolbar buttons are enabled but do nothing when clicked on. Disable them.
2.) The "more" drop down button should have the tbsButtonDrop style assigned because the button itself does nothing - only the drop down arrow shows a menu.
3.) "Add current" that would add the current project to the project group.
4.) The "Add" open dialog should use a summed-up filter (*.lpi;*.lpk;*.lpg;*.pas) as default top filter. I wanted to add a package and I needed some time to find out that I have to change the filter.
5.) Add the "New project group" menu item to the More drop down menu.
6.) Fix memory leak in TProjectGroupEditorForm.OnTargetDeleted - node data is not deleted here.

(More fixes coming soon - image indexes in particular.)
TagsNo tags attached.
Fixed in Revision61576.
LazTarget-
Widgetset
Attached Files
  • projectgroups-fixes-01.patch (16,837 bytes)
    Index: projectgroupeditor.lfm
    ===================================================================
    --- projectgroupeditor.lfm	(revision 61575)
    +++ projectgroupeditor.lfm	(working copy)
    @@ -1,7 +1,7 @@
     object ProjectGroupEditorForm: TProjectGroupEditorForm
    -  Left = 383
    +  Left = 190
       Height = 358
    -  Top = 187
    +  Top = 198
       Width = 646
       Caption = 'ProjectGroupEditorForm'
       ClientHeight = 358
    @@ -28,33 +28,36 @@
           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'
    @@ -61,30 +64,30 @@
           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
    @@ -91,7 +94,7 @@
       end
       object TVPG: TTreeView
         Left = 0
    -    Height = 291
    +    Height = 287
         Top = 48
         Width = 646
         Align = alClient
    @@ -110,8 +113,8 @@
       end
       object SBPG: TStatusBar
         Left = 0
    -    Height = 19
    -    Top = 339
    +    Height = 23
    +    Top = 335
         Width = 646
         Panels = <    
           item
    @@ -125,8 +128,8 @@
         SimplePanel = False
       end
       object ImageListMain: TImageList
    -    left = 128
    -    top = 184
    +    Left = 128
    +    Top = 184
         Bitmap = {
           4C691A0000001000000010000000FFFFFF009E6E4D2B9D6D4CD69D6D4BC59D6C
           4BFF9C6C4AFF9C6B49FF9B6A49FF9B6A48FF9A6947FF996846FF986745FF9364
    @@ -966,8 +969,11 @@
       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 @@
       end
       object ActionListMain: TActionList
         Images = ImageListMain
    -    left = 48
    -    top = 152
    +    Left = 48
    +    Top = 152
         object AProjectGroupSave: TAction
           Category = 'ProjectGroupActions'
           Caption = 'Save'
    @@ -1004,22 +1010,11 @@
         end
         object AProjectGroupAddExisting: TAction
           Category = 'ProjectGroupActions'
    -      Caption = 'Add'
    +      Caption = 'Add from file'
           ImageIndex = 8
           OnExecute = AProjectGroupAddExistingExecute
    +      OnUpdate = AProjectGroupAddExistingUpdate
         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 ATargetEarlier: TAction
           Category = 'TargetAction'
           Caption = 'Earlier'
    @@ -1099,11 +1094,37 @@
           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 @@
           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 @@
       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
    Index: projectgroupeditor.pas
    ===================================================================
    --- projectgroupeditor.pas	(revision 61575)
    +++ projectgroupeditor.pas	(working copy)
    @@ -47,6 +47,8 @@
       { TProjectGroupEditorForm }
     
       TProjectGroupEditorForm = class(TForm)
    +    AProjectGroupNew: TAction;
    +    AProjectGroupAddCurrent: TAction;
         ATargetInfo: TAction;
         AProjectGroupOptions: TAction;
         AProjectGroupRedo: TAction;
    @@ -71,6 +73,9 @@
         AProjectGroupSave: TAction;
         ActionListMain: TActionList;
         ImageListMain: TImageList;
    +    PMINew: TMenuItem;
    +    PMIAddExisting: TMenuItem;
    +    PMIAddCurrent: TMenuItem;
         PMIInfo: TMenuItem;
         PMIOptions: TMenuItem;
         PMIRedo: TMenuItem;
    @@ -87,6 +92,7 @@
         PMICompileClean: TMenuItem;
         PMICompile: TMenuItem;
         OpenDialogTarget: TOpenDialog;
    +    PopupMenuAdd: TPopupMenu;
         PopupMenuMore: TPopupMenu;
         PopupMenuTree: TPopupMenu;
         SBPG: TStatusBar;
    @@ -104,9 +110,13 @@
         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,6 +211,7 @@
         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);
    @@ -207,6 +218,7 @@
         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 @@
       // 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 @@
       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 @@
     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,6 +456,8 @@
       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);
    @@ -437,6 +464,7 @@
     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 @@
       N:=FindTVNodeOfTarget(Target);
       TVPG.BeginUpdate;
       try
    +    ClearChildNodes(N);
    +    ClearNodeData(N);
         TVPG.Items.Delete(N);
         TVPG.Selected:=FProjectGroupTVNode;
       finally
    @@ -842,35 +872,28 @@
     
     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 @@
         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 @@
       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 @@
         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;
    Index: projectgroupstrconst.pas
    ===================================================================
    --- projectgroupstrconst.pas	(revision 61575)
    +++ projectgroupstrconst.pas	(working copy)
    @@ -65,8 +65,14 @@
       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 @@
       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)';
    

Activities

Ondrej Pokorny

2019-07-12 12:31

reporter  

projectgroups-fixes-01.patch (16,837 bytes)
Index: projectgroupeditor.lfm
===================================================================
--- projectgroupeditor.lfm	(revision 61575)
+++ projectgroupeditor.lfm	(working copy)
@@ -1,7 +1,7 @@
 object ProjectGroupEditorForm: TProjectGroupEditorForm
-  Left = 383
+  Left = 190
   Height = 358
-  Top = 187
+  Top = 198
   Width = 646
   Caption = 'ProjectGroupEditorForm'
   ClientHeight = 358
@@ -28,33 +28,36 @@
       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'
@@ -61,30 +64,30 @@
       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
@@ -91,7 +94,7 @@
   end
   object TVPG: TTreeView
     Left = 0
-    Height = 291
+    Height = 287
     Top = 48
     Width = 646
     Align = alClient
@@ -110,8 +113,8 @@
   end
   object SBPG: TStatusBar
     Left = 0
-    Height = 19
-    Top = 339
+    Height = 23
+    Top = 335
     Width = 646
     Panels = <    
       item
@@ -125,8 +128,8 @@
     SimplePanel = False
   end
   object ImageListMain: TImageList
-    left = 128
-    top = 184
+    Left = 128
+    Top = 184
     Bitmap = {
       4C691A0000001000000010000000FFFFFF009E6E4D2B9D6D4CD69D6D4BC59D6C
       4BFF9C6C4AFF9C6B49FF9B6A49FF9B6A48FF9A6947FF996846FF986745FF9364
@@ -966,8 +969,11 @@
   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 @@
   end
   object ActionListMain: TActionList
     Images = ImageListMain
-    left = 48
-    top = 152
+    Left = 48
+    Top = 152
     object AProjectGroupSave: TAction
       Category = 'ProjectGroupActions'
       Caption = 'Save'
@@ -1004,22 +1010,11 @@
     end
     object AProjectGroupAddExisting: TAction
       Category = 'ProjectGroupActions'
-      Caption = 'Add'
+      Caption = 'Add from file'
       ImageIndex = 8
       OnExecute = AProjectGroupAddExistingExecute
+      OnUpdate = AProjectGroupAddExistingUpdate
     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 ATargetEarlier: TAction
       Category = 'TargetAction'
       Caption = 'Earlier'
@@ -1099,11 +1094,37 @@
       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 @@
       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 @@
   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
Index: projectgroupeditor.pas
===================================================================
--- projectgroupeditor.pas	(revision 61575)
+++ projectgroupeditor.pas	(working copy)
@@ -47,6 +47,8 @@
   { TProjectGroupEditorForm }
 
   TProjectGroupEditorForm = class(TForm)
+    AProjectGroupNew: TAction;
+    AProjectGroupAddCurrent: TAction;
     ATargetInfo: TAction;
     AProjectGroupOptions: TAction;
     AProjectGroupRedo: TAction;
@@ -71,6 +73,9 @@
     AProjectGroupSave: TAction;
     ActionListMain: TActionList;
     ImageListMain: TImageList;
+    PMINew: TMenuItem;
+    PMIAddExisting: TMenuItem;
+    PMIAddCurrent: TMenuItem;
     PMIInfo: TMenuItem;
     PMIOptions: TMenuItem;
     PMIRedo: TMenuItem;
@@ -87,6 +92,7 @@
     PMICompileClean: TMenuItem;
     PMICompile: TMenuItem;
     OpenDialogTarget: TOpenDialog;
+    PopupMenuAdd: TPopupMenu;
     PopupMenuMore: TPopupMenu;
     PopupMenuTree: TPopupMenu;
     SBPG: TStatusBar;
@@ -104,9 +110,13 @@
     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,6 +211,7 @@
     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);
@@ -207,6 +218,7 @@
     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 @@
   // 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 @@
   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 @@
 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,6 +456,8 @@
   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);
@@ -437,6 +464,7 @@
 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 @@
   N:=FindTVNodeOfTarget(Target);
   TVPG.BeginUpdate;
   try
+    ClearChildNodes(N);
+    ClearNodeData(N);
     TVPG.Items.Delete(N);
     TVPG.Selected:=FProjectGroupTVNode;
   finally
@@ -842,35 +872,28 @@
 
 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 @@
     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 @@
   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 @@
     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;
Index: projectgroupstrconst.pas
===================================================================
--- projectgroupstrconst.pas	(revision 61575)
+++ projectgroupstrconst.pas	(working copy)
@@ -65,8 +65,14 @@
   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 @@
   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)';

Mattias Gaertner

2019-07-12 14:09

manager   ~0117217

Big Thanks!

Ondrej Pokorny

2019-07-12 15:37

reporter   ~0117222

Thank you!

Issue History

Date Modified Username Field Change
2019-07-12 12:31 Ondrej Pokorny New Issue
2019-07-12 12:31 Ondrej Pokorny File Added: projectgroups-fixes-01.patch
2019-07-12 14:09 Mattias Gaertner Assigned To => Mattias Gaertner
2019-07-12 14:09 Mattias Gaertner Status new => resolved
2019-07-12 14:09 Mattias Gaertner Resolution open => fixed
2019-07-12 14:09 Mattias Gaertner Fixed in Revision => 61576.
2019-07-12 14:09 Mattias Gaertner LazTarget => -
2019-07-12 14:09 Mattias Gaertner Note Added: 0117217
2019-07-12 15:37 Ondrej Pokorny Status resolved => closed
2019-07-12 15:37 Ondrej Pokorny Note Added: 0117222