add diloag to create new dub project, deactivated for now

see added comment in main.pas

lazproj/coedit.lpi

@@ -522,7 +522,7 @@
         <PackageName Value="LCL"/>
       </Item8>
     </RequiredPackages>
-    <Units Count="60">
+    <Units Count="61">
       <Unit0>
         <Filename Value="coedit.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -836,6 +836,12 @@
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
       </Unit59>
+      <Unit60>
+        <Filename Value="..\src\ce_newdubproj.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="CeNewDubProject"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit60>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

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

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

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

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.
+