projects group, add a hybrid async compilation mode with wait points

lazproj/coedit.lpi

@@ -13,7 +13,7 @@
         <DpiAware Value="True"/>
       </XPManifest>
       <Icon Value="0"/>
-      <Resources Count="87">
+      <Resources Count="89">
         <Resource_0 FileName="../icons/window/layout_add.png" Type="RCDATA" ResourceName="LAYOUT_ADD"/>
         <Resource_1 FileName="../icons/window/layout.png" Type="RCDATA" ResourceName="LAYOUT"/>
         <Resource_2 FileName="../icons/window/application_go.png" Type="RCDATA" ResourceName="APPLICATION_GO"/>
@@ -101,6 +101,8 @@
         <Resource_84 FileName="../icons/other/tag_purple.png" Type="RCDATA" ResourceName="TAG_PURPLE"/>
         <Resource_85 FileName="../cesetup/version.txt" Type="RCDATA" ResourceName="VERSION"/>
         <Resource_86 FileName="../icons/other/sort_az.png" Type="RCDATA" ResourceName="SORT_AZ"/>
+        <Resource_87 FileName="../icons/arrow/arrow_divide.png" Type="RCDATA" ResourceName="ARROW_DIVIDE"/>
+        <Resource_88 FileName="../icons/arrow/arrow_join.png" Type="RCDATA" ResourceName="ARROW_JOIN"/>
       </Resources>
     </General>
     <i18n>

src/ce_interfaces.pas

@@ -347,6 +347,8 @@ type
     function findProject(const fname: string): ICECommonProject;
     // selects the nth project of the group.
     procedure setProjectIndex(index: Integer);
+    // indicates wether a project is marked for async compilation
+    function projectIsAsync(index: integer): boolean;
   end;
 
 

src/ce_main.lfm

@@ -3956,6 +3956,45 @@ object CEMainForm: TCEMainForm
           0000000000000000000000000000000000000000000000000000
         }
       end
+      object MenuItem104: TMenuItem
+        Action = actProjGroupCompileCustomSync
+        Bitmap.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000064000000640000000000000000000000000000000000
+          0000000000000000000000000000000000000000000000000000000000000000
+          001F000000080000003300000033000000040000002400000000000000000000
+          0000000000000000000000000000000000330000003300000033000000332D73
+          BAAF1B3D60523F93D4FF3F93D4FF102438413578BAC300000024000000000000
+          0000000000230000002F00000000B88445FFC89451FFCE934AFF6D8192FF40A9
+          EAFF429EDDFF52D0F8FF52D0F8FF439EDCFF48AAE2FF3980C8B6000000000000
+          0023AA7A3EBFB68243ED00000033B58142FFF5C378FFFCC371FFAD7E49FF3B9E
+          E3FF4ECFFBFF41B0EDFF42B1EDFF50CFFAFF439EDCFF1B3D5F5200000000AA7A
+          3FBED2A76FFFD7A561FFB88241FFD39F58FFEDB96BFFF7B962FF288DE3FF4CCF
+          FCFF40B0EDFFC39F7BFF987653CB42B1EEFF52D0F9FF3F92D5FF00000000B984
+          43E9DDBB8CFFEEC486FFE8B466FFF1CC96FFF7DCB5FFFFDEADFF288CDFFF4CCE
+          FBFF3FAFEDFFFAB66DFFC7751FCE41B1EFFF52D0F9FF3F92D5FF000000330000
+          0033B78242FFE4B163FFEBC68EFFEACFA9FFD1A774FFD9A970FFCCBBA4FF399C
+          E1FF4CCEFBFF3FB0EEFF40B1EFFF4FCFFCFF429EDCFF16324E31B98545FFB782
+          42FFC8934EFFDFAB5EFFE4C494FFB68245DAB8813F3CBE823B2561809CFF37A8
+          EFFF399DE3FF4CCFFDFF4AC7F8FF3D9EE1FF45AAE4FF3982CB9FC38F4EFFE2B5
+          72FFDEB06AFFDBA658FFC59555FF926935300000000000000000AA7333436A83
+          99FFCD9F5FFF298DE2FF2B8FE1FFB48B5AFF3081D29100000000C5995FFFF1DC
+          BBFFECD2ACFFD6A152FFC18C49FF70502A620000000C0000000C704F2861C88D
+          44FFDFA24CFFEACEA6FFF1D7B2FFD79A51FF0000000000000000B98442FFB680
+          3EFFCEA673FFDBAE6EFFCB954BFFB88344FF6E4F2A616E4F2A61B88344FFCD97
+          4AFFDCAE6DFFD0A772FFB9813CFFBE843FFF0000000000000000000000000000
+          002FBA8547FFCE9949FFDAB276FFC9944BFFBE8943FFBE8943FFC9944BFFDAB2
+          76FFCE9949FFBA8546FF0000002F00000000000000000000000000000000B782
+          42ECD3AE7CFFE7CBA4FFEAD4B2FFE8D0ADFFCF9D56FFCF9D56FFE8D0ADFFEAD4
+          B2FFE7CBA4FFD3AE7CFFB78242EC00000000000000000000000000000000B985
+          44AFCCA26CFFD4B080FFB98343FFCCA470FFC9984EFFC9984EFFCCA470FFB983
+          43FFD4B080FFCCA26CFFB98544AF000000000000000000000000000000000000
+          0000B98544AFB98443E900000000B78140FFE9D4B4FFE9D4B4FFB78140FF0000
+          0000B98443E9B98544AF00000000000000000000000000000000000000000000
+          0000000000000000000000000000BA8545FFB9843FFFB9843FFFBA8545FF0000
+          0000000000000000000000000000000000000000000000000000
+        }
+      end
     end
     object MenuItem8: TMenuItem
       Caption = 'Compilation'
@@ -4553,6 +4592,45 @@ object CEMainForm: TCEMainForm
           0000000000000000000000000000000000000000000000000000
         }
       end
+      object MenuItem105: TMenuItem
+        Action = actProjGroupCompileCustomSync
+        Bitmap.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000064000000640000000000000000000000000000000000
+          0000000000000000000000000000000000000000000000000000000000000000
+          001F000000080000003300000033000000040000002400000000000000000000
+          0000000000000000000000000000000000330000003300000033000000332D73
+          BAAF1B3D60523F93D4FF3F93D4FF102438413578BAC300000024000000000000
+          0000000000230000002F00000000B88445FFC89451FFCE934AFF6D8192FF40A9
+          EAFF429EDDFF52D0F8FF52D0F8FF439EDCFF48AAE2FF3980C8B6000000000000
+          0023AA7A3EBFB68243ED00000033B58142FFF5C378FFFCC371FFAD7E49FF3B9E
+          E3FF4ECFFBFF41B0EDFF42B1EDFF50CFFAFF439EDCFF1B3D5F5200000000AA7A
+          3FBED2A76FFFD7A561FFB88241FFD39F58FFEDB96BFFF7B962FF288DE3FF4CCF
+          FCFF40B0EDFFC39F7BFF987653CB42B1EEFF52D0F9FF3F92D5FF00000000B984
+          43E9DDBB8CFFEEC486FFE8B466FFF1CC96FFF7DCB5FFFFDEADFF288CDFFF4CCE
+          FBFF3FAFEDFFFAB66DFFC7751FCE41B1EFFF52D0F9FF3F92D5FF000000330000
+          0033B78242FFE4B163FFEBC68EFFEACFA9FFD1A774FFD9A970FFCCBBA4FF399C
+          E1FF4CCEFBFF3FB0EEFF40B1EFFF4FCFFCFF429EDCFF16324E31B98545FFB782
+          42FFC8934EFFDFAB5EFFE4C494FFB68245DAB8813F3CBE823B2561809CFF37A8
+          EFFF399DE3FF4CCFFDFF4AC7F8FF3D9EE1FF45AAE4FF3982CB9FC38F4EFFE2B5
+          72FFDEB06AFFDBA658FFC59555FF926935300000000000000000AA7333436A83
+          99FFCD9F5FFF298DE2FF2B8FE1FFB48B5AFF3081D29100000000C5995FFFF1DC
+          BBFFECD2ACFFD6A152FFC18C49FF70502A620000000C0000000C704F2861C88D
+          44FFDFA24CFFEACEA6FFF1D7B2FFD79A51FF0000000000000000B98442FFB680
+          3EFFCEA673FFDBAE6EFFCB954BFFB88344FF6E4F2A616E4F2A61B88344FFCD97
+          4AFFDCAE6DFFD0A772FFB9813CFFBE843FFF0000000000000000000000000000
+          002FBA8547FFCE9949FFDAB276FFC9944BFFBE8943FFBE8943FFC9944BFFDAB2
+          76FFCE9949FFBA8546FF0000002F00000000000000000000000000000000B782
+          42ECD3AE7CFFE7CBA4FFEAD4B2FFE8D0ADFFCF9D56FFCF9D56FFE8D0ADFFEAD4
+          B2FFE7CBA4FFD3AE7CFFB78242EC00000000000000000000000000000000B985
+          44AFCCA26CFFD4B080FFB98343FFCCA470FFC9984EFFC9984EFFCCA470FFB983
+          43FFD4B080FFCCA26CFFB98544AF000000000000000000000000000000000000
+          0000B98544AFB98443E900000000B78140FFE9D4B4FFE9D4B4FFB78140FF0000
+          0000B98443E9B98544AF00000000000000000000000000000000000000000000
+          0000000000000000000000000000BA8545FFB9843FFFB9843FFFBA8545FF0000
+          0000000000000000000000000000000000000000000000000000
+        }
+      end
       object MenuItem90: TMenuItem
         Caption = '-'
       end
@@ -5067,7 +5145,7 @@ object CEMainForm: TCEMainForm
     end
     object actProjGroupCompile: TAction
       Category = 'ProjectsGroup'
-      Caption = 'Compile projects group (parallel)'
+      Caption = 'Compile projects group in parallel'
       ImageIndex = 21
       OnExecute = actProjGroupCompileExecute
     end
@@ -5093,10 +5171,16 @@ object CEMainForm: TCEMainForm
     end
     object actProjGroupCompileSync: TAction
       Category = 'ProjectsGroup'
-      Caption = 'Compile projects group (sequential)'
+      Caption = 'Compile projects group sequentially'
       ImageIndex = 21
       OnExecute = actProjGroupCompileSyncExecute
     end
+    object actProjGroupCompileCustomSync: TAction
+      Category = 'ProjectsGroup'
+      Caption = 'compile projects group using wait points'
+      ImageIndex = 21
+      OnExecute = actProjGroupCompileCustomSyncExecute
+    end
     object actProjGroupClose: TAction
       Category = 'ProjectsGroup'
       Caption = 'Close projects group'

src/ce_main.pas

@@ -25,6 +25,8 @@ type
     property OnMouseWheel;
   end;
 
+  TAsynWait = (awNo, awYes, awCustom);
+
   TRunnableToFolderCondition = (
     ifInProject,  // runnable src is part of the project
     ifNotSaved,   // runnable src is an unsaved module (tmp_XXXXX)
@@ -98,6 +100,7 @@ type
     actFileRunDub: TAction;
     actFileRunDubOut: TAction;
     actFileNewDubScript: TAction;
+    actProjGroupCompileCustomSync: TAction;
     actProjGroupClose: TAction;
     actProjGroupCompileSync: TAction;
     actProjGroupCompile: TAction;
@@ -143,6 +146,8 @@ type
     MenuItem101: TMenuItem;
     MenuItem102: TMenuItem;
     MenuItem103: TMenuItem;
+    MenuItem104: TMenuItem;
+    MenuItem105: TMenuItem;
     MenuItem11: TMenuItem;
     MenuItem12: TMenuItem;
     MenuItem13: TMenuItem;
@@ -254,6 +259,7 @@ type
     procedure actFileSaveCopyAsExecute(Sender: TObject);
     procedure actNewGroupExecute(Sender: TObject);
     procedure actProjAddToGroupExecute(Sender: TObject);
+    procedure actProjGroupCompileCustomSyncExecute(Sender: TObject);
     procedure actProjGroupCompileExecute(Sender: TObject);
     procedure actProjGroupCompileSyncExecute(Sender: TObject);
     procedure actProjNewDubJsonExecute(Sender: TObject);
@@ -438,7 +444,7 @@ type
     function closeProj: boolean;
     procedure showProjTitle;
     function  checkProjectLock(message: boolean = true): boolean;
-    procedure compileGroup(async: boolean);
+    procedure compileGroup(async: TAsynWait);
 
     // mru
     procedure mruChange(Sender: TObject);
@@ -3381,9 +3387,11 @@ end;
 // TODO-cFileOpenDialog: allow multi selection when possible
 //(open file, add file to project, ...)
 
-procedure TCEMainForm.compileGroup(async: boolean);
+// TODO-cprojectsgroup: add a "out of mem" protection in async mode.
+
+procedure TCEMainForm.compileGroup(async: TAsynWait);
 var
-  i: integer;
+  i, j: integer;
 begin
   if checkProjectLock then
     exit;
@@ -3395,8 +3403,23 @@ begin
   for i:= 0 to fProjectGroup.projectCount-1 do
   begin
     fProjectGroup.getProject(i).activate;
+    // customized async mode: wait
+    if not fProjectGroup.projectIsAsync(i) and (async = awCustom) then
+    begin
+      while fGroupCompilationCnt <> i do
+        Application.ProcessMessages;
+      for j:= 0 to i-1 do
+        if not fProjectGroup.getProject(j).compiled then
+      begin
+        fMsgs.message('group compilation has stopped because of a failure',
+          nil, amcAll, amkErr);
+        fIsCompilingGroup := false;
+        break;
+      end;
+    end;
     fProject.compile;
-    if not async then
+    // sequential
+    if (async = awNo) then
     begin
       while fProjActionsLock do
         Application.ProcessMessages;
@@ -3407,18 +3430,23 @@ begin
         fIsCompilingGroup := false;
         break;
       end;
-    end;
+    end
   end;
 end;
 
 procedure TCEMainForm.actProjGroupCompileExecute(Sender: TObject);
 begin
-  compileGroup(true);
+  compileGroup(awYes);
 end;
 
 procedure TCEMainForm.actProjGroupCompileSyncExecute(Sender: TObject);
 begin
-  compileGroup(false);
+  compileGroup(awNo);
+end;
+
+procedure TCEMainForm.actProjGroupCompileCustomSyncExecute(Sender: TObject);
+begin
+  compileGroup(awCustom);
 end;
 
 procedure TCEMainForm.actProjNewGroupExecute(Sender: TObject);

src/ce_projgroup.lfm

@@ -35,10 +35,15 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
             Caption = 'Type'
             Width = 39
           end        
+          item
+            AutoSize = True
+            Caption = 'Async'
+            Width = 48
+          end        
           item
             AutoSize = True
             Caption = 'Configuration'
-            Width = 230
+            Width = 182
           end>
         GridLines = True
         ReadOnly = True
@@ -46,6 +51,7 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
         TabOrder = 0
         ViewStyle = vsReport
         OnDblClick = lstProjDblClick
+        OnSelectItem = slstProjSelectItem
       end
       object Panel2: TPanel[1]
         Left = 4
@@ -130,6 +136,23 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
         resourceName = 'ARROW_UP'
         scaledSeparator = False
       end
+      object btnAsync: TCEToolButton[4]
+        Left = 129
+        Hint = 'async compilation mode'
+        Top = 0
+        Caption = 'btnAsync'
+        OnClick = btnAsyncClick
+        scaledSeparator = False
+      end
+      object button0: TCEToolButton[5]
+        Left = 113
+        Height = 28
+        Top = 0
+        Width = 16
+        Caption = 'button0'
+        Style = tbsDivider
+        scaledSeparator = False
+      end
     end
   end
   inherited contextMenu: TPopupMenu

src/ce_projgroup.pas

@@ -14,6 +14,13 @@ type
 
   TProjectGroup = class;
 
+  TCEProjectAsyncMode = (amSequential, amParallel);
+
+const
+  asyncStr: array[TCEProjectAsyncMode] of string = ('wait', 'async');
+
+type
+
   (**
    * Represents a project in a project group
    *)
@@ -22,8 +29,10 @@ type
     fFilename: string;
     fProj: ICECommonProject;
     fGroup: TProjectGroup;
+    fAsyncMode: TCEProjectAsyncMode;
   published
     property filename: string read fFilename write fFilename;
+    property asyncMode: TCEProjectAsyncMode read fAsyncMode write fAsyncMode;
   public
     property project: ICECommonProject read fProj;
     procedure lazyLoad;
@@ -73,6 +82,7 @@ type
     function getProject(ix: Integer): ICECommonProject;
     function findProject(const fname: string): ICECommonProject;
     procedure setProjectIndex(value: Integer);
+    function projectIsAsync(index: integer): boolean;
     //
     function addItem(const fname: string): TProjectGroupItem;
     property item[ix: integer]: TProjectGroupItem read getItem; default;
@@ -91,6 +101,7 @@ type
   TCEProjectGroupWidget = class(TCEWidget, ICEProjectObserver)
     BtnAddProj: TCEToolButton;
     btnAddUnfocused: TSpeedButton;
+    btnAsync: TCEToolButton;
     btnFreeFocus: TSpeedButton;
     btnMoveDown: TCEToolButton;
     btnMoveUp: TCEToolButton;
@@ -99,12 +110,15 @@ type
     Panel2: TPanel;
     StaticText1: TStaticText;
     procedure btnAddUnfocusedClick(Sender: TObject);
+    procedure btnAsyncClick(Sender: TObject);
     procedure btnFreeFocusClick(Sender: TObject);
     procedure BtnAddProjClick(Sender: TObject);
     procedure btnMoveDownClick(Sender: TObject);
     procedure btnMoveUpClick(Sender: TObject);
     procedure btnRemProjClick(Sender: TObject);
     procedure lstProjDblClick(Sender: TObject);
+    procedure slstProjSelectItem(Sender: TObject; Item: TListItem;
+      Selected: Boolean);
   private
     fPrevProj: ICECommonProject;
     fFreeProj: ICECommonProject;
@@ -117,6 +131,7 @@ type
     procedure projCompiling(project: ICECommonProject);
     procedure projCompiled(project: ICECommonProject; success: boolean);
     //
+    procedure updateButtons;
     procedure updateList;
     procedure handleChanged(sender: TObject);
   protected
@@ -218,6 +233,11 @@ begin
   end;
 end;
 
+function TProjectGroup.projectIsAsync(index: integer): boolean;
+begin
+  exit(item[index].asyncMode = amParallel);
+end;
+
 function TProjectGroup.addItem(const fname: string): TProjectGroupItem;
 var
   it: TCollectionItem;
@@ -541,6 +561,20 @@ begin
   updateList;
 end;
 
+procedure TCEProjectGroupWidget.btnAsyncClick(Sender: TObject);
+var
+  prj: TProjectGroupItem;
+begin
+  if lstProj.ItemIndex = -1 then exit;
+  //
+  prj := projectGroup.item[lstProj.ItemIndex];
+  case prj.asyncMode of
+    amSequential: prj.asyncMode := amParallel;
+    amParallel: prj.asyncMode := amSequential;
+  end;
+  updateButtons;
+end;
+
 procedure TCEProjectGroupWidget.btnMoveDownClick(Sender: TObject);
 begin
   if lstProj.ItemIndex = -1 then exit;
@@ -580,6 +614,12 @@ begin
     projectGroup.setProjectIndex(lstProj.ItemIndex);
 end;
 
+procedure TCEProjectGroupWidget.slstProjSelectItem(Sender: TObject;
+  Item: TListItem; Selected: Boolean);
+begin
+  updateButtons
+end;
+
 procedure TCEProjectGroupWidget.handleChanged(sender: TObject);
 begin
   updateList;
@@ -590,10 +630,47 @@ begin
   end;
 end;
 
+procedure TCEProjectGroupWidget.updateButtons;
+var
+  idx: integer;
+  asc: TCEProjectAsyncMode;
+begin
+  idx := lstProj.ItemIndex;
+  if idx = -1 then
+  begin
+    btnMoveDown.Enabled:= false;
+    btnMoveUp.Enabled:= false;
+    btnRemProj.Enabled:= false;
+    btnAsync.Enabled:= false;
+  end
+  else
+  begin
+    btnMoveDown.Enabled:= idx <> projectGroup.projectCount-1;
+    btnMoveUp.Enabled:= idx <> 0;
+    btnRemProj.Enabled:= true;
+    btnAsync.Enabled:= true;
+    asc := projectGroup.item[idx].asyncMode;
+    case asc of
+      amSequential:
+      begin
+        btnAsync.resourceName:= 'ARROW_JOIN';
+        btnAsync.hint := 'do no wait for the previous projects';
+      end;
+      amParallel:
+      begin
+        btnAsync.resourceName:= 'ARROW_DIVIDE';
+        btnAsync.hint := 'wait for the previous projects';
+      end;
+    end;
+    lstProj.Items.Item[idx].SubItems[1] := asyncStr[asc];
+  end;
+end;
+
 procedure TCEProjectGroupWidget.updateList;
 var
   i: integer;
-  p: TProjectGroupItem;
+  prj: TProjectGroupItem;
+  fmt: TCEProjectFormat;
 const
   typeStr: array[TCEProjectFormat] of string = ('CE','DUB');
 begin
@@ -602,16 +679,18 @@ begin
   begin
     with lstProj.Items.Add do
     begin
-      p := projectGroup.item[i];
+      prj := projectGroup.item[i];
-      p.fGroup := projectGroup;
+      prj.fGroup := projectGroup;
-      p.lazyLoad;
+      prj.lazyLoad;
-      Data:= p;
+      Data:= prj;
-      case p.project.getFormat of
+      fmt := prj.project.getFormat;
-        pfNative: Caption := p.fFilename.extractFileName;
+      case fmt of
-        pfDub: Caption := TCEDubProject(p.project.getProject).packageName;
+        pfNative: Caption := prj.fFilename.extractFileName;
+        pfDub: Caption := TCEDubProject(prj.project.getProject).packageName;
       end;
-      SubItems.Add(typeStr[p.fProj.getFormat]);
+      SubItems.Add(typeStr[fmt]);
-      SubItems.Add(p.fProj.configurationName(p.fProj.getActiveConfigurationIndex));
+      SubItems.Add(asyncStr[prj.fAsyncMode]);
+      SubItems.Add(prj.fProj.configurationName(prj.fProj.getActiveConfigurationIndex));
     end;
   end;
   if fFreeProj <> nil then
@@ -626,6 +705,7 @@ begin
   end
   else
     StaticText1.Caption:= 'No free standing project';
+  updateButtons;
 end;
 {$ENDREGION}