unit Keyman.Developer.UI.Project.UfrmNewModelProjectParameters; interface uses System.Classes, System.SysUtils, System.UITypes, System.Variants, Winapi.Messages, Winapi.Windows, Vcl.CheckLst, Vcl.Controls, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.Grids, Vcl.StdCtrls, Browse4Folder, kpsfile, PackageInfo, UfrmTike, utilfiletypes; type TfrmNewModelProjectParameters = class(TTikeForm) lblFileName: TLabel; lblPath: TLabel; lblAuthorID: TLabel; lblCoypright: TLabel; lblVersion: TLabel; lblAuthor: TLabel; lblLanguages: TLabel; editModelID: TEdit; cmdBrowse: TButton; editPath: TEdit; editAuthorID: TEdit; editCopyright: TEdit; editVersion: TEdit; editAuthor: TEdit; cmdOK: TButton; cmdCancel: TButton; gridLanguages: TStringGrid; cmdAddLanguage: TButton; cmdEditLanguage: TButton; cmdRemoveLanguage: TButton; lblBCP47: TLabel; lblUniq: TLabel; editUniq: TEdit; cbBCP47: TComboBox; lblModelName: TLabel; editModelName: TEdit; Bevel1: TBevel; lblProjectFilename: TLabel; editProjectFilename: TEdit; Label1: TLabel; editFullCopyright: TEdit; procedure cmdOKClick(Sender: TObject); procedure editModelIDComponentChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure gridLanguagesClick(Sender: TObject); procedure gridLanguagesDblClick(Sender: TObject); procedure cmdAddLanguageClick(Sender: TObject); procedure cmdEditLanguageClick(Sender: TObject); procedure cmdRemoveLanguageClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure editCopyrightChange(Sender: TObject); procedure editVersionChange(Sender: TObject); procedure editAuthorChange(Sender: TObject); procedure editPathChange(Sender: TObject); procedure editModelIDChange(Sender: TObject); procedure cmdBrowseClick(Sender: TObject); procedure editModelNameChange(Sender: TObject); procedure editFullCopyrightChange(Sender: TObject); private pack: TKPSFile; FSetup: Integer; dlgBrowse: TBrowse4Folder; function GetAuthor: string; function GetBasePath: string; function GetCopyright: string; function GetBCP47Tags: string; function GetVersion: string; function Validate: Boolean; procedure EnableControls; function SelectedLanguage: TPackageKeyboardLanguage; procedure LanguageGrid_Fill; procedure BCP47_Fill; function SelectedLexicalModel: TPackageLexicalModel; function GetModelID: string; procedure UpdateAuthorIDFromAuthor; procedure UpdateUniqFromModelName; function GetModelName: string; function GetAuthorID: string; function GetPrimaryBCP47: string; function GetUniq: string; procedure UpdateModelIDFromComponents; procedure UpdateProjectFilename; function GetFullCopyright: string; protected function GetHelpTopic: string; override; property AuthorID: string read GetAuthorID; property PrimaryBCP47: string read GetPrimaryBCP47; property Uniq: string read GetUniq; public property Copyright: string read GetCopyright; property FullCopyright: string read GetFullCopyright; property Version: string read GetVersion; property Author: string read GetAuthor; property ModelName: string read GetModelName; property BCP47Tags: string read GetBCP47Tags; property BasePath: string read GetBasePath; property ModelID: string read GetModelID; end; function ShowNewModelProjectParameters(Owner: TComponent): Boolean; implementation uses Keyman.System.LanguageCodeUtils, Keyman.System.LexicalModelUtils, BCP47Tag, utilstr, dmActionsMain, KeymanDeveloperOptions, Keyman.Developer.System.HelpTopics, Keyman.Developer.System.Project.Project, Keyman.Developer.System.Project.ProjectFile, Keyman.Developer.System.ModelProjectTemplate, Keyman.Developer.System.ProjectTemplate, Keyman.Developer.UI.UfrmSelectBCP47Language; {$R *.dfm} function ShowNewModelProjectParameters(Owner: TComponent): Boolean; var f: TfrmNewModelProjectParameters; pt: TProjectTemplate; begin f := TfrmNewModelProjectParameters.Create(Owner); try Result := f.ShowModal = mrOk; if not Result then Exit; pt := TModelProjectTemplate.Create(f.BasePath, f.ModelID); try pt.Name := f.ModelName; pt.Copyright := f.Copyright; pt.FullCopyright := f.FullCopyright; pt.Author := f.Author; pt.Version := f.Version; pt.BCP47Tags := f.BCP47Tags; try pt.Generate; except on E:EFOpenError do begin ShowMessage('Unable to create project: '+E.Message); Exit(False); end; end; modActionsMain.OpenProject(pt.ProjectFilename); Result := True; finally pt.Free; end; finally f.Free; end; end; { TfrmNewModelProjectParameters } procedure TfrmNewModelProjectParameters.FormCreate(Sender: TObject); begin inherited; editPath.Text := FKeymanDeveloperOptions.DefaultProjectPath; dlgBrowse := TBrowse4Folder.Create(Self); dlgBrowse.InitialDir := editPath.Text; dlgBrowse.Options := [OnlySelectFileSysAncestors, ShowEditBox, UseNewDialogStyle]; dlgBrowse.Root := Desktop; dlgBrowse.Title := 'Select folder to save project to'; pack := TKPSFile.Create; pack.LexicalModels.Add(TPackageLexicalModel.Create(pack)); LanguageGrid_Fill; EnableControls; end; procedure TfrmNewModelProjectParameters.FormDestroy(Sender: TObject); begin inherited; FreeAndNil(pack); end; function TfrmNewModelProjectParameters.GetHelpTopic: string; begin Result := SHelpTopic_Context_NewModelProjectParameters; end; procedure TfrmNewModelProjectParameters.cmdBrowseClick(Sender: TObject); begin dlgBrowse.InitialDir := editPath.Text; if dlgBrowse.Execute and (dlgBrowse.FileName <> '') then editPath.Text := ExcludeTrailingPathDelimiter(dlgBrowse.FileName); end; procedure TfrmNewModelProjectParameters.cmdAddLanguageClick( Sender: TObject); var lm: TPackageLexicalModel; lang: TPackageKeyboardLanguage; frm: TfrmSelectBCP47Language; begin lm := SelectedLexicalModel; Assert(Assigned(lm)); frm := TfrmSelectBCP47Language.Create(Self); try if frm.ShowModal = mrOk then begin lang := TPackageKeyboardLanguage.Create(pack); lang.ID := frm.LanguageID; lang.Name := frm.LanguageName; lm.Languages.Add(lang); BCP47_Fill; LanguageGrid_Fill; gridLanguages.Row := gridLanguages.RowCount - 1; gridLanguagesClick(gridLanguages); EnableControls; end; finally frm.Free; end; end; procedure TfrmNewModelProjectParameters.cmdEditLanguageClick( Sender: TObject); var lm: TPackageLexicalModel; lang: TPackageKeyboardLanguage; frm: TfrmSelectBCP47Language; begin lm := SelectedLexicalModel; Assert(Assigned(lm)); lang := SelectedLanguage; Assert(Assigned(lang)); frm := TfrmSelectBCP47Language.Create(Self); try frm.LanguageID := lang.ID; frm.LanguageName := lang.Name; if frm.ShowModal = mrOk then begin lang.ID := frm.LanguageID; lang.Name := frm.LanguageName; BCP47_Fill; LanguageGrid_Fill; EnableControls; end; finally frm.Free; end; end; procedure TfrmNewModelProjectParameters.cmdRemoveLanguageClick( Sender: TObject); var lm: TPackageLexicalModel; lang: TPackageKeyboardLanguage; begin lm := SelectedLexicalModel; Assert(Assigned(lm)); lang := SelectedLanguage; Assert(Assigned(lang)); lm.Languages.Remove(lang); LanguageGrid_Fill; BCP47_Fill; EnableControls; end; procedure TfrmNewModelProjectParameters.cmdOKClick(Sender: TObject); begin if Validate then ModalResult := mrOk; end; procedure TfrmNewModelProjectParameters.editAuthorChange(Sender: TObject); begin UpdateAuthorIDFromAuthor; EnableControls; end; procedure TfrmNewModelProjectParameters.editModelNameChange(Sender: TObject); begin UpdateUniqFromModelName; EnableControls; end; procedure TfrmNewModelProjectParameters.editCopyrightChange(Sender: TObject); begin EnableControls; end; procedure TfrmNewModelProjectParameters.editFullCopyrightChange( Sender: TObject); begin EnableControls; end; procedure TfrmNewModelProjectParameters.editModelIDChange(Sender: TObject); begin UpdateProjectFilename; EnableControls; end; procedure TfrmNewModelProjectParameters.editModelIDComponentChange(Sender: TObject); begin UpdateModelIDFromComponents; EnableControls; end; procedure TfrmNewModelProjectParameters.editPathChange(Sender: TObject); begin UpdateProjectFilename; EnableControls; end; procedure TfrmNewModelProjectParameters.editVersionChange(Sender: TObject); begin EnableControls; end; procedure TfrmNewModelProjectParameters.EnableControls; var e: Boolean; begin e := not Author.IsEmpty and not ModelName.IsEmpty and not AuthorID.IsEmpty and not PrimaryBCP47.IsEmpty and not Uniq.IsEmpty and not Trim(editPath.Text).IsEmpty and TLexicalModelUtils.DoesProjectFilenameFollowLexicalModelConventions(editModelID.Text + Ext_LexicalModelProject) and (pack.LexicalModels[0].Languages.Count > 0); cmdOK.Enabled := e; e := gridLanguages.RowCount > 1; gridLanguages.Enabled := e; cmdRemoveLanguage.Enabled := e; cmdEditLanguage.Enabled := e; if e then gridLanguages.FixedRows := 1; end; function TfrmNewModelProjectParameters.GetAuthor: string; begin Result := Trim(editAuthor.Text); end; function TfrmNewModelProjectParameters.GetAuthorID: string; begin Result := Trim(editAuthorID.Text); end; function TfrmNewModelProjectParameters.GetBasePath: string; begin Result := Trim(editPath.Text); end; function TfrmNewModelProjectParameters.GetCopyright: string; begin Result := Trim(editCopyright.Text); end; function TfrmNewModelProjectParameters.GetFullCopyright: string; begin Result := editFullCopyright.Text; end; function TfrmNewModelProjectParameters.GetModelID: string; begin Result := editModelID.Text; end; function TfrmNewModelProjectParameters.GetModelName: string; begin Result := Trim(editModelName.Text); end; function TfrmNewModelProjectParameters.GetPrimaryBCP47: string; begin Result := Trim(cbBCP47.Text); end; function TfrmNewModelProjectParameters.GetUniq: string; begin Result := Trim(editUniq.Text); end; function TfrmNewModelProjectParameters.GetBCP47Tags: string; var lang: TPackageKeyboardLanguage; begin Result := ''; for lang in pack.LexicalModels[0].Languages do Result := Result + lang.ID + ' '; Result := Result.Trim; end; function TfrmNewModelProjectParameters.GetVersion: string; begin Result := Trim(editVersion.Text); end; procedure TfrmNewModelProjectParameters.gridLanguagesClick( Sender: TObject); begin EnableControls; end; procedure TfrmNewModelProjectParameters.gridLanguagesDblClick( Sender: TObject); begin if SelectedLanguage <> nil then cmdEditLanguage.Click; end; function TfrmNewModelProjectParameters.Validate: Boolean; var ProjectFolder: string; begin Result := TLexicalModelUtils.DoesProjectFilenameFollowLexicalModelConventions(editModelID.Text + Ext_LexicalModelProject); if Result then begin if not DirectoryExists(editPath.Text) then begin if MessageDlg('The target folder '+editPath.Text+' does not exist. Create it now?', mtConfirmation, mbOkCancel, 0) = mrCancel then Exit(False); end; ProjectFolder := IncludeTrailingPathDelimiter(editPath.Text) + editModelID.Text; if DirectoryExists(ProjectFolder) then begin if MessageDlg('The project folder '+ProjectFolder+' already exists. Are you sure you want to overwrite it?', mtWarning, mbOkCancel, 0) = mrCancel then Exit(False); end; end; end; { Dynamically update other fields based on filled details } procedure TfrmNewModelProjectParameters.UpdateAuthorIDFromAuthor; begin editAuthorID.Text := TLexicalModelUtils.CleanLexicalModelIDComponent(Author); editCopyright.Text := Char($00A9 {copyright})+' '+Author; editFullCopyright.Text := Char($00A9 {copyright})+' '+FormatDateTime('yyyy', Now)+' '+Author; end; procedure TfrmNewModelProjectParameters.UpdateUniqFromModelName; begin editUniq.Text := TLexicalModelUtils.CleanLexicalModelIDComponent(ModelName); end; procedure TfrmNewModelProjectParameters.UpdateModelIDFromComponents; begin editModelID.Text := Format('%s.%s.%s', [AuthorID, PrimaryBCP47.ToLowerInvariant, Uniq]); end; procedure TfrmNewModelProjectParameters.UpdateProjectFilename; begin editProjectFilename.Text := IncludeTrailingPathDelimiter(BasePath) + ModelID + PathDelim + ModelID + Ext_LexicalModelProject; // Scroll to the end of the control to show the filename editProjectFilename.Perform(EM_SETSEL, Length(editProjectFilename.Text), Length(editProjectFilename.Text)); editProjectFilename.Perform(EM_SCROLLCARET, 0, 0); end; { Languages Grid } function TfrmNewModelProjectParameters.SelectedLexicalModel: TPackageLexicalModel; begin Result := pack.LexicalModels[0]; end; function TfrmNewModelProjectParameters.SelectedLanguage: TPackageKeyboardLanguage; var lm: TPackageLexicalModel; begin lm := SelectedLexicalModel; if not Assigned(lm) then Exit(nil); if gridLanguages.Row = 0 then Exit(nil); Result := gridLanguages.Objects[0, gridLanguages.Row] as TPackageKeyboardLanguage; end; procedure TfrmNewModelProjectParameters.LanguageGrid_Fill; var lm: TPackageLexicalModel; i: Integer; begin Inc(FSetup); try gridLanguages.Cells[0, 0] := 'BCP 47 tag'; gridLanguages.Cells[1, 0] := 'Language name'; gridLanguages.ColWidths[0] := 120; gridLanguages.ColWidths[1] := 10; lm := SelectedLexicalModel; if not Assigned(lm) then begin gridLanguages.RowCount := 1; EnableControls; Exit; end; gridLanguages.RowCount := lm.Languages.Count + 1; gridLanguages.ColWidths[1] := gridLanguages.ClientWidth - 120 - 1; for i := 0 to lm.Languages.Count - 1 do begin gridLanguages.Objects[0, i+1] := lm.Languages[i]; gridLanguages.Cells[0, i+1] := lm.Languages[i].ID; gridLanguages.Cells[1, i+1] := lm.Languages[i].Name; end; EnableControls; finally Dec(FSetup); end; end; procedure TfrmNewModelProjectParameters.BCP47_Fill; var lm: TPackageLexicalModel; FLastBCP47: string; lang: TPackageKeyboardLanguage; begin FLastBCP47 := cbBCP47.Text; cbBCP47.Clear; lm := SelectedLexicalModel; if not Assigned(lm) then Exit; for lang in lm.Languages do cbBCP47.Items.Add(lang.ID); cbBCP47.ItemIndex := cbBCP47.Items.IndexOf(FLastBCP47); if (cbBCP47.ItemIndex < 0) and (cbBCP47.Items.Count > 0) then cbBCP47.ItemIndex := 0; editModelIDComponentChange(cbBCP47); end; end.