unit Keyman.Developer.UI.Project.UfrmNewProjectParameters; interface uses System.Classes, System.SysUtils, System.UITypes, System.Variants, Winapi.Messages, Winapi.Windows, Vcl.CheckLst, Vcl.Controls, Vcl.Dialogs, Vcl.Forms, Vcl.Graphics, Vcl.Grids, Vcl.StdCtrls, kpsfile, PackageInfo, UfrmTike, UKeymanTargets, utilfiletypes, Browse4Folder; type TfrmNewProjectParameters = class(TTikeForm) lblFileName: TLabel; lblPath: TLabel; editKeyboardID: TEdit; cmdBrowse: TButton; editPath: TEdit; lblKeyboardName: TLabel; editKeyboardName: TEdit; lblCoypright: TLabel; editCopyright: TEdit; lblVersion: TLabel; editVersion: TEdit; lblAuthor: TLabel; editAuthor: TEdit; cmdOK: TButton; cmdCancel: TButton; lblTargets: TLabel; clbTargets: TCheckListBox; gridKeyboardLanguages: TStringGrid; cmdKeyboardAddLanguage: TButton; cmdKeyboardEditLanguage: TButton; cmdKeyboardRemoveLanguage: TButton; lblKeyboardLanguages: TLabel; lblProjectFilename: TLabel; editProjectFilename: TEdit; Label1: TLabel; editFullCopyright: TEdit; Label2: TLabel; memoDescription: TMemo; procedure cmdOKClick(Sender: TObject); procedure editKeyboardNameChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure gridKeyboardLanguagesClick(Sender: TObject); procedure gridKeyboardLanguagesDblClick(Sender: TObject); procedure cmdKeyboardAddLanguageClick(Sender: TObject); procedure cmdKeyboardEditLanguageClick(Sender: TObject); procedure cmdKeyboardRemoveLanguageClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure editCopyrightChange(Sender: TObject); procedure editVersionChange(Sender: TObject); procedure editAuthorChange(Sender: TObject); procedure clbTargetsClickCheck(Sender: TObject); procedure editPathChange(Sender: TObject); procedure editKeyboardIDChange(Sender: TObject); procedure cmdBrowseClick(Sender: TObject); procedure editFullCopyrightChange(Sender: TObject); procedure memoDescriptionChange(Sender: TObject); private dlgBrowse: TBrowse4Folder; pack: TKPSFile; // Used temporarily for storing language list FSetup: Integer; function GetAuthor: string; function GetBasePath: string; function GetCopyright: string; function GetKeyboardID: string; function GetKeyboardName: string; function GetBCP47Tags: string; function GetTargets: TKeymanTargets; function GetVersion: string; function Validate: Boolean; procedure EnableControls; function SelectedKeyboardLanguage: TPackageKeyboardLanguage; procedure LanguageGrid_Fill; function SelectedKeyboard: TPackageKeyboard; procedure SetBCP47Tags(const Value: string); procedure SetKeyboardID(const Value: string); procedure SetKeyboardName(const Value: string); procedure UpdateProjectFilename; function GetFullCopyright: string; function GetDescription: string; protected function GetHelpTopic: string; override; public property Copyright: string read GetCopyright; property FullCopyright: string read GetFullCopyright; property Version: string read GetVersion; property Author: string read GetAuthor; property Targets: TKeymanTargets read GetTargets; property BCP47Tags: string read GetBCP47Tags write SetBCP47Tags; property BasePath: string read GetBasePath; property Description: string read GetDescription; property KeyboardName: string read GetKeyboardName write SetKeyboardName; property KeyboardID: string read GetKeyboardID write SetKeyboardID; end; function ShowNewProjectParameters(Owner: TComponent): Boolean; implementation uses Keyman.System.CanonicalLanguageCodeUtils, Keyman.System.LanguageCodeUtils, BCP47Tag, utilstr, dmActionsMain, KeymanDeveloperOptions, Keyman.Developer.System.HelpTopics, Keyman.Developer.System.Project.Project, Keyman.Developer.System.Project.ProjectFile, Keyman.Developer.System.KeyboardProjectTemplate, Keyman.Developer.System.ProjectTemplate, Keyman.Developer.UI.UfrmSelectBCP47Language, Keyman.System.KeyboardUtils; // 1. project filename // 2. location // 3. keyboard name // 4. copyright // 5. targets // 6. author // 7. version // 8. bcp47 tags // 9. description {$R *.dfm} function ShowNewProjectParameters(Owner: TComponent): Boolean; var f: TfrmNewProjectParameters; pt: TKeyboardProjectTemplate; begin f := TfrmNewProjectParameters.Create(Owner); try Result := f.ShowModal = mrOk; if not Result then Exit; pt := TKeyboardProjectTemplate.Create(f.BasePath, f.KeyboardID, f.Targets); try pt.Name := f.KeyboardName; pt.Copyright := f.Copyright; pt.FullCopyright := f.FullCopyright; pt.Author := f.Author; pt.Version := f.Version; pt.Description := f.Description; pt.BCP47Tags := f.BCP47Tags; pt.IncludeIcon := True; 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; { TfrmNewBasicProjectParameters } procedure TfrmNewProjectParameters.FormCreate(Sender: TObject); var i: TKeymanTarget; begin inherited; editPath.Text := FKeymanDeveloperOptions.DefaultProjectPath; editFullCopyright.Text := 'Copyright '+Char($00A9 {copyright})+' '+FormatDateTime('yyyy', Now)+' '; dlgBrowse := TBrowse4Folder.Create(Self); dlgBrowse.InitialDir := editPath.Text; dlgBrowse.Options := [OnlySelectFileSysDir, ShowEditBox, UseNewDialogStyle]; dlgBrowse.Root := Desktop; dlgBrowse.Title := 'Select folder to save project to'; pack := TKPSFile.Create; pack.Keyboards.Add(TPackageKeyboard.Create(pack)); for i := Low(TKeymanTarget) to High(TKeymanTarget) do // I4504 clbTargets.Items.Add(SKeymanTargets[i]); clbTargets.Checked[0] := True; LanguageGrid_Fill; EnableControls; end; procedure TfrmNewProjectParameters.FormDestroy(Sender: TObject); begin inherited; FreeAndNil(pack); end; procedure TfrmNewProjectParameters.clbTargetsClickCheck(Sender: TObject); begin EnableControls; end; procedure TfrmNewProjectParameters.cmdBrowseClick(Sender: TObject); begin dlgBrowse.InitialDir := editPath.Text; if dlgBrowse.Execute and (dlgBrowse.FileName <> '') then editPath.Text := ExcludeTrailingPathDelimiter(dlgBrowse.FileName); end; procedure TfrmNewProjectParameters.cmdKeyboardAddLanguageClick( Sender: TObject); var k: TPackageKeyboard; lang: TPackageKeyboardLanguage; frm: TfrmSelectBCP47Language; begin k := SelectedKeyboard; Assert(Assigned(k)); frm := TfrmSelectBCP47Language.Create(Self); try if frm.ShowModal = mrOk then begin lang := TPackageKeyboardLanguage.Create(pack); lang.ID := frm.LanguageID; lang.Name := frm.LanguageName; k.Languages.Add(lang); LanguageGrid_Fill; gridKeyboardLanguages.Row := gridKeyboardLanguages.RowCount - 1; gridKeyboardLanguagesClick(gridKeyboardLanguages); EnableControls; end; finally frm.Free; end; end; procedure TfrmNewProjectParameters.cmdKeyboardEditLanguageClick( Sender: TObject); var k: TPackageKeyboard; lang: TPackageKeyboardLanguage; frm: TfrmSelectBCP47Language; begin k := SelectedKeyboard; Assert(Assigned(k)); lang := SelectedKeyboardLanguage; 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; LanguageGrid_Fill; EnableControls; end; finally frm.Free; end; end; procedure TfrmNewProjectParameters.cmdKeyboardRemoveLanguageClick( Sender: TObject); var k: TPackageKeyboard; lang: TPackageKeyboardLanguage; begin k := SelectedKeyboard; Assert(Assigned(k)); lang := SelectedKeyboardLanguage; Assert(Assigned(lang)); k.Languages.Remove(lang); LanguageGrid_Fill; EnableControls; end; procedure TfrmNewProjectParameters.cmdOKClick(Sender: TObject); begin if Validate then ModalResult := mrOk; end; procedure TfrmNewProjectParameters.editAuthorChange(Sender: TObject); begin EnableControls; if not editCopyright.Modified then editCopyright.Text := 'Copyright '+Char($00A9 {copyright})+' '+Author; if not editFullCopyright.Modified then editFullCopyright.Text := 'Copyright '+Char($00A9 {copyright})+' '+FormatDateTime('yyyy', Now)+' '+Author; end; procedure TfrmNewProjectParameters.editCopyrightChange(Sender: TObject); begin EnableControls; end; procedure TfrmNewProjectParameters.editFullCopyrightChange(Sender: TObject); begin EnableControls; end; procedure TfrmNewProjectParameters.editKeyboardIDChange(Sender: TObject); begin UpdateProjectFilename; EnableControls; end; procedure TfrmNewProjectParameters.editKeyboardNameChange(Sender: TObject); begin if not editKeyboardID.Modified then editKeyboardID.Text := TKeyboardUtils.CleanKeyboardID(Trim(editKeyboardName.Text)); EnableControls; end; procedure TfrmNewProjectParameters.editPathChange(Sender: TObject); begin UpdateProjectFilename; EnableControls; end; procedure TfrmNewProjectParameters.editVersionChange(Sender: TObject); begin EnableControls; end; procedure TfrmNewProjectParameters.EnableControls; var e: Boolean; begin e := (Trim(editKeyboardName.Text) <> '') and (Trim(editPath.Text) <> '') and TKeyboardUtils.IsValidKeyboardID(Trim(editKeyboardID.Text), True) and (GetTargets <> []) and (Trim(memoDescription.Text) <> ''); cmdOK.Enabled := e; e := gridKeyboardLanguages.RowCount > 1; gridKeyboardLanguages.Enabled := e; cmdKeyboardRemoveLanguage.Enabled := e; cmdKeyboardEditLanguage.Enabled := e; if e then gridKeyboardLanguages.FixedRows := 1; end; function TfrmNewProjectParameters.GetAuthor: string; begin Result := Trim(editAuthor.Text); end; function TfrmNewProjectParameters.GetBasePath: string; begin Result := Trim(editPath.Text); end; function TfrmNewProjectParameters.GetCopyright: string; begin Result := Trim(editCopyright.Text); end; function TfrmNewProjectParameters.GetDescription: string; begin Result := Trim(memoDescription.Text); end; function TfrmNewProjectParameters.GetFullCopyright: string; begin Result := Trim(editFullCopyright.Text); end; function TfrmNewProjectParameters.GetHelpTopic: string; begin Result := SHelpTopic_Context_NewProjectParameters; end; function TfrmNewProjectParameters.GetKeyboardID: string; begin Result := Trim(LowerCase(editKeyboardID.Text)); end; function TfrmNewProjectParameters.GetKeyboardName: string; begin Result := Trim(editKeyboardName.Text); end; function TfrmNewProjectParameters.GetBCP47Tags: string; var lang: TPackageKeyboardLanguage; begin Result := ''; for lang in pack.Keyboards[0].Languages do Result := Result + lang.ID + ' '; Result := Result.Trim; end; function TfrmNewProjectParameters.GetTargets: TKeymanTargets; var i: Integer; begin Result := []; for i := 0 to clbTargets.Items.Count - 1 do if clbTargets.Checked[i] then Include(Result, TKeymanTarget(i)); end; function TfrmNewProjectParameters.GetVersion: string; begin Result := Trim(editVersion.Text); end; procedure TfrmNewProjectParameters.gridKeyboardLanguagesClick( Sender: TObject); begin EnableControls; end; procedure TfrmNewProjectParameters.gridKeyboardLanguagesDblClick( Sender: TObject); begin if SelectedKeyboardLanguage <> nil then cmdKeyboardEditLanguage.Click; end; function TfrmNewProjectParameters.Validate: Boolean; var ProjectFolder: string; begin Result := TKeyboardUtils.IsValidKeyboardID(Trim(editKeyboardID.Text), True); 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) + editKeyboardID.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; { Languages Grid } function TfrmNewProjectParameters.SelectedKeyboard: TPackageKeyboard; begin Result := pack.Keyboards[0]; end; function TfrmNewProjectParameters.SelectedKeyboardLanguage: TPackageKeyboardLanguage; var k: TPackageKeyboard; begin k := SelectedKeyboard; if not Assigned(k) then Exit(nil); if gridKeyboardLanguages.Row = 0 then Exit(nil); Result := gridKeyboardLanguages.Objects[0, gridKeyboardLanguages.Row] as TPackageKeyboardLanguage; end; procedure TfrmNewProjectParameters.SetBCP47Tags(const Value: string); var Tag, Tags: string; BCP47Tag: TBCP47Tag; Language: TPackageKeyboardLanguage; begin pack.Keyboards[0].Languages.Clear; Tags := Trim(Value); while Trim(Tags) <> '' do begin Tag := StrToken(Tags, ' '); BCP47Tag := TBCP47Tag.Create(Tag); try BCP47Tag.Tag := TCanonicalLanguageCodeUtils.FindBestTag(BCP47Tag.Tag, False, False); if BCP47Tag.IsValid(False) then begin Language := TPackageKeyboardLanguage.Create(pack); Language.ID := BCP47Tag.Tag; if not TLanguageCodeUtils.BCP47Languages.TryGetValue(BCP47Tag.Language, Language.Name) then Language.Name := Language.ID; pack.Keyboards[0].Languages.Add(Language); end; finally BCP47Tag.Free; end; end; LanguageGrid_Fill; EnableControls; end; procedure TfrmNewProjectParameters.SetKeyboardID(const Value: string); begin editKeyboardID.Text := Value; EnableControls; end; procedure TfrmNewProjectParameters.SetKeyboardName(const Value: string); begin editKeyboardName.Text := Value; EnableControls; end; procedure TfrmNewProjectParameters.LanguageGrid_Fill; var k: TPackageKeyboard; i: Integer; begin Inc(FSetup); try gridKeyboardLanguages.Cells[0, 0] := 'BCP 47 tag'; gridKeyboardLanguages.Cells[1, 0] := 'Language name'; gridKeyboardLanguages.ColWidths[0] := 120; gridKeyboardLanguages.ColWidths[1] := 10; k := SelectedKeyboard; if not Assigned(k) then begin gridKeyboardLanguages.RowCount := 1; EnableControls; Exit; end; gridKeyboardLanguages.RowCount := k.Languages.Count + 1; gridKeyboardLanguages.ColWidths[1] := gridKeyboardLanguages.ClientWidth - 120 - 1; for i := 0 to k.Languages.Count - 1 do begin gridKeyboardLanguages.Objects[0, i+1] := k.Languages[i]; gridKeyboardLanguages.Cells[0, i+1] := k.Languages[i].ID; gridKeyboardLanguages.Cells[1, i+1] := k.Languages[i].Name; end; EnableControls; finally Dec(FSetup); end; end; procedure TfrmNewProjectParameters.memoDescriptionChange(Sender: TObject); begin EnableControls; end; procedure TfrmNewProjectParameters.UpdateProjectFilename; begin editProjectFilename.Text := IncludeTrailingPathDelimiter(BasePath) + KeyboardID + PathDelim + KeyboardID + Ext_ProjectSource; // 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; end.