diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index 840565e7..d4b94bdd 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -13,7 +13,7 @@
-
+
@@ -101,6 +101,8 @@
+
+
diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas
index 1fde34b2..ea621b86 100644
--- a/src/ce_interfaces.pas
+++ b/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;
diff --git a/src/ce_main.lfm b/src/ce_main.lfm
index e7aee0bb..1c7a72be 100644
--- a/src/ce_main.lfm
+++ b/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'
diff --git a/src/ce_main.pas b/src/ce_main.pas
index 387a86b9..52e20342 100644
--- a/src/ce_main.pas
+++ b/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);
diff --git a/src/ce_projgroup.lfm b/src/ce_projgroup.lfm
index 13f939fb..cb1dda31 100644
--- a/src/ce_projgroup.lfm
+++ b/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
diff --git a/src/ce_projgroup.pas b/src/ce_projgroup.pas
index 9e71deb3..04eb16da 100644
--- a/src/ce_projgroup.pas
+++ b/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];
- p.fGroup := projectGroup;
- p.lazyLoad;
- Data:= p;
- case p.project.getFormat of
- pfNative: Caption := p.fFilename.extractFileName;
- pfDub: Caption := TCEDubProject(p.project.getProject).packageName;
+ prj := projectGroup.item[i];
+ prj.fGroup := projectGroup;
+ prj.lazyLoad;
+ Data:= prj;
+ fmt := prj.project.getFormat;
+ case fmt of
+ pfNative: Caption := prj.fFilename.extractFileName;
+ pfDub: Caption := TCEDubProject(prj.project.getProject).packageName;
end;
- SubItems.Add(typeStr[p.fProj.getFormat]);
- SubItems.Add(p.fProj.configurationName(p.fProj.getActiveConfigurationIndex));
+ SubItems.Add(typeStr[fmt]);
+ 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}