diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index 72f2b1bb..81038fbd 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -522,7 +522,7 @@
-
+
@@ -836,6 +836,12 @@
+
+
+
+
+
+
diff --git a/src/ce_main.lfm b/src/ce_main.lfm
index 40ad7026..47bdceb4 100644
--- a/src/ce_main.lfm
+++ b/src/ce_main.lfm
@@ -1,11 +1,11 @@
object CEMainForm: TCEMainForm
Left = 383
- Height = 54
+ Height = 35
Top = 610
Width = 687
AllowDropFiles = True
Caption = 'Coedit'
- ClientHeight = 54
+ ClientHeight = 35
ClientWidth = 687
Icon.Data = {
F1B500000000010001000000000001002000DBB500001600000089504E470D0A
@@ -1472,7 +1472,6 @@ object CEMainForm: TCEMainForm
OnResize = FormResize
OnWindowStateChange = FormWindowStateChange
ShowHint = True
- LCLVersion = '1.8.4.0'
Visible = False
object mainMenu: TMainMenu
top = 1
@@ -1634,6 +1633,9 @@ object CEMainForm: TCEMainForm
Caption = 'Project'
object mnuProjNew: TMenuItem
Caption = 'New project'
+ object mnuItemDubDialog: TMenuItem
+ Action = actProjNewDialog
+ end
object MenuItem69: TMenuItem
Action = actProjNewDubJson
end
@@ -2280,6 +2282,11 @@ object CEMainForm: TCEMainForm
OnExecute = actProjStopCompExecute
OnUpdate = updateProjectBasedAction
end
+ object actProjNewDialog: TAction
+ Category = 'Project'
+ Caption = 'New project dialog...'
+ OnExecute = actProjNewDialogExecute
+ end
end
object ApplicationProperties1: TApplicationProperties
OnActivate = ApplicationProperties1Activate
diff --git a/src/ce_main.pas b/src/ce_main.pas
index de26b488..018b21a6 100644
--- a/src/ce_main.pas
+++ b/src/ce_main.pas
@@ -16,7 +16,7 @@ uses
ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes,
ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor,{$IFDEF UNIX} ce_gdb,{$ENDIF}
ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange, ce_dastworx,
- ce_halstead, ce_profileviewer, ce_semver, ce_dsgncontrols, ce_term;
+ ce_halstead, ce_profileviewer, ce_semver, ce_dsgncontrols, ce_term, ce_newdubproj;
type
@@ -117,6 +117,7 @@ type
actFileCloseAll: TAction;
actFileNewClip: TAction;
actEdFormat: TAction;
+ actProjNewDialog: TAction;
actProjStopComp: TAction;
actProjTest: TAction;
actLayoutReset: TAction;
@@ -177,6 +178,7 @@ type
MenuItem112: TMenuItem;
MenuItem113: TMenuItem;
MenuItem114: TMenuItem;
+ mnuItemDubDialog: TMenuItem;
mnuItemHelp: TMenuItem;
mnuItemAbout: TMenuItem;
mnuItemCheckUpd: TMenuItem;
@@ -305,6 +307,7 @@ type
procedure actProjGroupCompileCustomSyncExecute(Sender: TObject);
procedure actProjGroupCompileExecute(Sender: TObject);
procedure actProjGroupCompileSyncExecute(Sender: TObject);
+ procedure actProjNewDialogExecute(Sender: TObject);
procedure actProjNewDubJsonExecute(Sender: TObject);
procedure actProjNewGroupExecute(Sender: TObject);
procedure actProjNewNativeExecute(Sender: TObject);
@@ -1266,6 +1269,10 @@ begin
getCMdParams;
fAppliOpts.assignTo(self);
+ // waiting for interative mode working when piped:
+ // https://github.com/dlang/dub/issues/1500
+ mnuItemDubDialog.Visible:=false;
+
InitOptionsMenu;
mainMenu.Items.Remove(mnuItemHelp);
@@ -3726,6 +3733,25 @@ begin
result := true;
end;
+procedure TCEMainForm.actProjNewDialogExecute(Sender: TObject);
+var
+ r: TModalResult;
+begin
+ if assigned(fProject) and not fProject.inGroup and fProject.modified and
+ (dlgFileChangeClose(fProject.filename, UnsavedProj) = mrCancel) then
+ exit;
+ if not closeProj then
+ exit;
+ with TCeNewDubProject.create(nil) do
+ try
+ r := ShowModal();
+ if r = mrOk then
+ openProj(ce_newdubproj.createdNewProject);
+ finally
+ free;
+ end;
+end;
+
procedure TCEMainForm.actProjNewDubJsonExecute(Sender: TObject);
begin
if assigned(fProject) and not fProject.inGroup and fProject.modified and
diff --git a/src/ce_newdubproj.lfm b/src/ce_newdubproj.lfm
new file mode 100644
index 00000000..90f7d703
--- /dev/null
+++ b/src/ce_newdubproj.lfm
@@ -0,0 +1,255 @@
+object CeNewDubProject: TCeNewDubProject
+ Left = 0
+ Height = 419
+ Top = 0
+ Width = 439
+ Caption = 'New DUB project'
+ ClientHeight = 419
+ ClientWidth = 439
+ Position = poMainFormCenter
+ Visible = False
+ object GroupBox1: TGroupBox
+ Left = 4
+ Height = 50
+ Top = 4
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project directory'
+ ClientHeight = 32
+ ClientWidth = 429
+ TabOrder = 0
+ object edDir: TDirectoryEdit
+ Left = 4
+ Height = 23
+ Hint = 'select project directory, mandatory'
+ Top = 4
+ Width = 421
+ ShowHidden = False
+ ButtonWidth = 23
+ NumGlyphs = 1
+ Flat = True
+ Align = alClient
+ BorderSpacing.Around = 4
+ MaxLength = 0
+ TabOrder = 0
+ OnEditingDone = edNameChange
+ end
+ object lblValidDir: TLabel
+ Left = 0
+ Height = 1
+ Top = 31
+ Width = 429
+ Align = alBottom
+ ParentColor = False
+ end
+ end
+ object GroupBox2: TGroupBox
+ Left = 4
+ Height = 49
+ Top = 58
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project name'
+ ClientHeight = 31
+ ClientWidth = 429
+ TabOrder = 1
+ object edName: TEdit
+ Left = 4
+ Height = 23
+ Hint = 'enter project name, optional, no spaces allowed'
+ Top = 4
+ Width = 421
+ Align = alTop
+ BorderSpacing.Around = 4
+ OnChange = edNameChange
+ TabOrder = 0
+ TextHint = 'project name, optional'
+ end
+ object lblValidName: TLabel
+ Left = 0
+ Height = 1
+ Top = 30
+ Width = 429
+ Align = alBottom
+ ParentColor = False
+ end
+ end
+ object GroupBox3: TGroupBox
+ Left = 4
+ Height = 49
+ Top = 217
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project license'
+ ClientHeight = 31
+ ClientWidth = 429
+ TabOrder = 2
+ object edLic: TEdit
+ Left = 4
+ Height = 23
+ Hint = 'license, left empty for proprietary'
+ Top = 4
+ Width = 421
+ Align = alClient
+ BorderSpacing.Around = 4
+ OnChange = edNameChange
+ TabOrder = 0
+ TextHint = 'license, left empty for proprietary'
+ end
+ end
+ object GroupBox4: TGroupBox
+ Left = 4
+ Height = 49
+ Hint = 'enter copyright string, optional'
+ Top = 270
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project copyright string'
+ ClientHeight = 31
+ ClientWidth = 429
+ TabOrder = 3
+ object edCopyR: TEdit
+ Left = 4
+ Height = 23
+ Hint = 'copyright string, optional'
+ Top = 4
+ Width = 421
+ Align = alClient
+ BorderSpacing.Around = 4
+ OnChange = edNameChange
+ TabOrder = 0
+ TextHint = 'copyright string, optional'
+ end
+ end
+ object GroupBox5: TGroupBox
+ Left = 4
+ Height = 50
+ Top = 323
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project dependencies'
+ ClientHeight = 32
+ ClientWidth = 429
+ TabOrder = 4
+ object edDeps: TEdit
+ Left = 4
+ Height = 23
+ Hint = 'enter dependencies, space separated'
+ Top = 4
+ Width = 421
+ Align = alClient
+ BorderSpacing.Around = 4
+ OnChange = edNameChange
+ TabOrder = 0
+ TextHint = 'dependencies, space separated'
+ end
+ object lblValidDeps: TLabel
+ Left = 0
+ Height = 1
+ Top = 31
+ Width = 429
+ Align = alBottom
+ ParentColor = False
+ end
+ end
+ object pnlFooter: TPanel
+ Left = 4
+ Height = 14
+ Top = 401
+ Width = 431
+ Align = alBottom
+ AutoSize = True
+ BorderSpacing.Around = 4
+ BevelOuter = bvLowered
+ ClientHeight = 14
+ ClientWidth = 431
+ TabOrder = 5
+ OnEnter = edNameChange
+ object btnCancel: TSpeedButton
+ Left = 412
+ Height = 4
+ Hint = 'cancel and revert the modifications of the category'
+ Top = 5
+ Width = 4
+ Align = alRight
+ AutoSize = True
+ BorderSpacing.Left = 2
+ BorderSpacing.Around = 4
+ Flat = True
+ OnClick = btnCancelClick
+ end
+ object btnAccept: TSpeedButton
+ Left = 422
+ Height = 4
+ Hint = 'accept the modifications of the category'
+ Top = 5
+ Width = 4
+ Align = alRight
+ AutoSize = True
+ BorderSpacing.Left = 2
+ BorderSpacing.Around = 4
+ Flat = True
+ OnClick = btnAcceptClick
+ end
+ end
+ object GroupBox6: TGroupBox
+ Left = 4
+ Height = 49
+ Top = 111
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project description'
+ ClientHeight = 31
+ ClientWidth = 429
+ TabOrder = 6
+ object edDescr: TEdit
+ Left = 4
+ Height = 23
+ Hint = 'enter project description, optional'
+ Top = 4
+ Width = 421
+ Align = alTop
+ BorderSpacing.Around = 4
+ OnChange = edNameChange
+ TabOrder = 0
+ TextHint = 'project description, optional'
+ end
+ end
+ object GroupBox7: TGroupBox
+ Left = 4
+ Height = 49
+ Top = 164
+ Width = 431
+ Align = alTop
+ AutoSize = True
+ BorderSpacing.Around = 4
+ Caption = 'Project author'
+ ClientHeight = 31
+ ClientWidth = 429
+ TabOrder = 7
+ object edAuthor: TEdit
+ Left = 4
+ Height = 23
+ Hint = 'enter project author, optional, current user name will be used'
+ Top = 4
+ Width = 421
+ Align = alTop
+ BorderSpacing.Around = 4
+ OnChange = edNameChange
+ TabOrder = 0
+ TextHint = 'project description, optional'
+ end
+ end
+end
diff --git a/src/ce_newdubproj.pas b/src/ce_newdubproj.pas
new file mode 100644
index 00000000..7e2a1880
--- /dev/null
+++ b/src/ce_newdubproj.pas
@@ -0,0 +1,226 @@
+unit ce_newdubproj;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
+ StdCtrls, ExtCtrls, Menus, Buttons, process,
+ ce_common, ce_sharedres, ce_stringrange;
+
+type
+
+ TCeNewDubProject = class(TForm)
+ btnAccept: TSpeedButton;
+ btnCancel: TSpeedButton;
+ edAuthor: TEdit;
+ edName: TEdit;
+ edLic: TEdit;
+ edCopyR: TEdit;
+ edDeps: TEdit;
+ edDescr: TEdit;
+ GroupBox3: TGroupBox;
+ GroupBox4: TGroupBox;
+ GroupBox5: TGroupBox;
+ GroupBox6: TGroupBox;
+ GroupBox7: TGroupBox;
+ lblValidName: TLabel;
+ lblValidDir: TLabel;
+ lblValidDeps: TLabel;
+ pnlFooter: TPanel;
+ ssgsdg: TBoundLabel;
+ edDir: TDirectoryEdit;
+ GroupBox1: TGroupBox;
+ GroupBox2: TGroupBox;
+ procedure btnAcceptClick(Sender: TObject);
+ procedure btnCancelClick(Sender: TObject);
+ procedure edNameChange(Sender: TObject);
+ private
+ deps: array of string;
+ function canCreate: boolean;
+ function isDirValid: boolean;
+ function isNameValid: boolean;
+ function areDepsValid: boolean;
+ procedure updateBtnAccept;
+ public
+ constructor create(aOwner: TComponent); override;
+ end;
+
+var
+ createdNewProject: string;
+
+implementation
+{$R *.lfm}
+
+constructor TCeNewDubProject.create(aOwner: TComponent);
+begin
+ createdNewProject := '';
+ inherited;
+ case GetIconScaledSize of
+ iss16:
+ begin
+ AssignPng(btnCancel, 'CANCEL');
+ AssignPng(btnAccept, 'ACCEPT');
+ end;
+ iss24:
+ begin
+ AssignPng(btnCancel, 'CANCEL24');
+ AssignPng(btnAccept, 'ACCEPT24');
+ end;
+ iss32:
+ begin
+ AssignPng(btnCancel, 'CANCEL32');
+ AssignPng(btnAccept, 'ACCEPT32');
+ end;
+ end;
+ width := ScaleX(350, 96);
+ height:= ScaleY(400, 96);
+end;
+
+function TCeNewDubProject.isDirValid: boolean;
+begin
+ lblValidDir.Caption := '';
+ result := edDir.Directory.isEmpty or (edDir.Directory.dirExists
+ and not FileIsInDirectory('dub.json', edDir.Directory)
+ and not FileIsInDirectory('dub.sdl', edDir.Directory)
+ and not FileIsInDirectory('package.json', edDir.Directory)
+ and not FileIsInDirectory('package.sdl', edDir.Directory));
+ if not result then
+ lblValidDir.Caption :=
+ 'ERROR: Invalid directory or directory already contains a DUB package';
+end;
+
+function TCeNewDubProject.isNameValid: boolean;
+var
+ s: string;
+begin
+ lblValidName.Caption := '';
+ result := true;
+ s := edName.Text;
+ if not s.isEmpty then
+ with TStringRange.create(s) do
+ result := popWhile(['a'..'z', 'A'..'Z', '0'..'9', '-', '_'])^.empty;
+ if not result then
+ lblValidName.Caption :=
+ 'ERROR: Invalid name. Name must be empty of made of alphanumeric chars, "-" and "_"';
+end;
+
+function TCeNewDubProject.areDepsValid: boolean;
+var
+ s: string;
+ d: string;
+ r: TStringRange = (ptr:nil; pos:0; len:0);
+begin
+ setLength(deps, 0);
+ lblValidDeps.Caption := '';
+ result := true;
+ s := edDeps.Text;
+ if s.isEmpty then
+ exit;
+ r.init(s);
+ while not r.empty do
+ begin
+ r.popWhile([' ']);
+ if not r.empty then
+ if not (r.front in ['a'..'z', 'A'..'Z', '0'..'9', '-', '_']) then
+ begin
+ result := false;
+ lblValidDeps.Caption := 'ERROR: Invalid char found in dependency identifier.';
+ break;
+ end;
+ if r.empty then
+ break;
+ d := r.takeWhile(['a'..'z', 'A'..'Z', '0'..'9', '-', '_']).yield;
+ if not d.isEmpty then
+ begin
+ setLength(deps, length(deps) + 1);
+ deps[high(deps)] := d;
+ end;
+ lblValidDeps.Caption := lblValidDeps.Caption + 'dep: ' + d + ' ';
+ end;
+end;
+
+function TCeNewDubProject.canCreate: boolean;
+begin
+ result := isDirValid and isNameValid and areDepsValid;
+end;
+
+procedure TCeNewDubProject.updateBtnAccept;
+begin
+ btnAccept.Enabled := canCreate;
+end;
+
+procedure TCeNewDubProject.edNameChange(Sender: TObject);
+begin
+ updateBtnAccept;
+end;
+
+procedure TCeNewDubProject.btnCancelClick(Sender: TObject);
+begin
+ ModalResult:= mrCancel;
+end;
+
+procedure TCeNewDubProject.btnAcceptClick(Sender: TObject);
+var
+ p: TProcess;
+ s: string;
+ i: integer;
+ o: TStringList;
+begin
+ p := TProcess.Create(nil);
+ o := TStringList.Create;
+ try
+ p.Executable:= 'dub'+ exeExt;
+ p.Options:= p.Options + [poUsePipes, poNoConsole];
+ p.ShowWindow:= swoHIDE;
+ p.Parameters.Add('init');
+ p.Execute;
+ // format
+ processOutputToStrings(p, o);
+ s := 'json'#10;
+ p.Input.Write(s[1], s.length);
+ // directory
+ processOutputToStrings(p, o);
+ s := edDir.Directory + #10;
+ p.Input.Write(s[1], s.length);
+ // name
+ processOutputToStrings(p, o);
+ s := edName.Text + #10;
+ p.Input.Write(s[1], s.length);
+ // description
+ processOutputToStrings(p, o);
+ s := edDescr.Text + #10;
+ p.Input.Write(s[1], s.length);
+ // author
+ processOutputToStrings(p, o);
+ s := edAuthor.Text + #10;
+ p.Input.Write(s[1], s.length);
+ // license
+ processOutputToStrings(p, o);
+ s := edLic.Text + #10;
+ p.Input.Write(s[1], s.length);
+ // copyright
+ processOutputToStrings(p, o);
+ s := edCopyR.Text + #10;
+ p.Input.Write(s[1], s.length);
+ // deps
+ for i := 0 to high(deps) do
+ begin
+ processOutputToStrings(p, o);
+ s := deps[i];
+ p.Input.Write(s[1], s.length);
+ end;
+ processOutputToStrings(p, o);
+ p.Input.WriteByte(10);
+ p.CloseInput;
+ finally
+ p.Free;
+ o.Free;
+ end;
+ createdNewProject := edDir.Directory + DirectorySeparator + 'dub.json';
+ ModalResult := mrOK;
+end;
+
+end.
+