From 4c5a91081f81f15917e737f472a282f23d60adfd Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Tue, 7 Nov 2023 05:18:25 +0700 Subject: [PATCH] feat(developer): Support v2.0 projects in TIKE Relates to #9948. Starts basic support for v2.0 projects. For all operating modes: - Remove blank projects / untitled projects mode - Add Open Project Folder buttons and links - Remove Project Save As - Render uses in-memory XML - Upgrade to v2.0 project file (along with checks) For v2.0 projects: - Remove 'Add File to Project' - Populate Files to list all files in folder (note: consider efficiency here as currently files are parsed for subfile data) - Version 2.0 project options and defaults --- .../windows/delphi/general/utilfiletypes.pas | 2 +- developer/src/tike/actions/dmActionsMain.dfm | 25 +- developer/src/tike/actions/dmActionsMain.pas | 63 +-- developer/src/tike/dialogs/UfrmNew.pas | 4 +- developer/src/tike/main/UfrmMain.dfm | 6 +- developer/src/tike/main/UfrmMain.pas | 30 +- ...n.Developer.System.Project.ProjectFile.pas | 503 ++++++++++++------ ...Developer.System.Project.ProjectLoader.pas | 144 +++-- ....Developer.System.Project.ProjectSaver.pas | 68 ++- ...man.Developer.UI.Project.ProjectFileUI.pas | 17 +- .../Keyman.Developer.UI.Project.ProjectUI.pas | 26 +- ...an.Developer.UI.Project.UfrmNewProject.dfm | 19 +- ...an.Developer.UI.Project.UfrmNewProject.pas | 18 - ...eyman.Developer.UI.Project.UfrmProject.pas | 8 + ...an.Developer.UI.Project.UpgradeProject.pas | 60 +++ developer/src/tike/tike.dpr | 3 +- developer/src/tike/tike.dproj | 1 + .../src/tike/xml/project/distribution.xsl | 12 +- developer/src/tike/xml/project/elements.xsl | 15 + .../src/tike/xml/project/globalwelcome.xsl | 4 + developer/src/tike/xml/project/keyboards.xsl | 14 +- developer/src/tike/xml/project/models.xsl | 14 +- developer/src/tike/xml/project/packages.xsl | 12 +- developer/src/tike/xml/project/project.css | 14 + developer/src/tike/xml/project/welcome.xsl | 2 + 25 files changed, 722 insertions(+), 362 deletions(-) create mode 100644 developer/src/tike/project/Keyman.Developer.UI.Project.UpgradeProject.pas diff --git a/common/windows/delphi/general/utilfiletypes.pas b/common/windows/delphi/general/utilfiletypes.pas index 56a718bcd06..539a3557b1b 100644 --- a/common/windows/delphi/general/utilfiletypes.pas +++ b/common/windows/delphi/general/utilfiletypes.pas @@ -94,7 +94,7 @@ TKeymanFileTypeInfo = class end; type - TKeymanProjectType = (kptUnknown, kptBasic, kptBlank, kptImportWindowsKeyboard, kptBlankLexicalModel, kptWordlistLexicalModel); + TKeymanProjectType = (kptUnknown, kptBasic, kptImportWindowsKeyboard, kptWordlistLexicalModel); implementation diff --git a/developer/src/tike/actions/dmActionsMain.dfm b/developer/src/tike/actions/dmActionsMain.dfm index 8b53150dfe5..09890f90613 100644 --- a/developer/src/tike/actions/dmActionsMain.dfm +++ b/developer/src/tike/actions/dmActionsMain.dfm @@ -32,6 +32,17 @@ object modActionsMain: TmodActionsMain OnExecute = actViewCharacterIdentifierExecute OnUpdate = actViewCharacterIdentifierUpdate end + object actProjectOpenFolder: TBrowseForFolder + Category = 'Project' + Caption = 'Open Project Folder...' + DialogCaption = 'Open Project Folder' + BrowseOptions = [] + BrowseOptionsEx = [] + Hint = 'Open Project Folder|Opens an existing project folder' + ShortCut = 24655 + UseFileDialog = True + OnAccept = actProjectOpenFolderAccept + end object actFileOpen: TFileOpen Category = 'File' Caption = '&Open...' @@ -248,22 +259,8 @@ object modActionsMain: TmodActionsMain Dialog.Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] Hint = 'Open Project|Opens an existing project' ImageIndex = 28 - ShortCut = 16463 OnAccept = actProjectOpenAccept end - object actProjectSaveAs: TFileSaveAs - Category = 'Project' - Caption = 'Save Project &As...' - Dialog.DefaultExt = 'kpj' - Dialog.Filter = 'Keyman Developer Project Files (*.kpj)|*.kpj|All Files (*.*)|*.*' - Dialog.Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] - Dialog.Title = 'Save Project As' - Dialog.OnCanClose = actProjectSaveAsSaveDialogCanClose - Hint = 'Save Project As|Saves the current project with a new name' - BeforeExecute = actProjectSaveAsBeforeExecute - OnAccept = actProjectSaveAsAccept - OnUpdate = actProjectSaveAsUpdate - end object actProjectAddCurrentEditorFile: TAction Category = 'Project' Caption = '&Current Editor File' diff --git a/developer/src/tike/actions/dmActionsMain.pas b/developer/src/tike/actions/dmActionsMain.pas index f13b57e29f1..163e9ce7a08 100644 --- a/developer/src/tike/actions/dmActionsMain.pas +++ b/developer/src/tike/actions/dmActionsMain.pas @@ -102,7 +102,6 @@ TmodActionsMain = class(TDataModule) actViewStatusBar: TAction; actProjectNew: TAction; actProjectOpen: TFileOpen; - actProjectSaveAs: TFileSaveAs; actProjectAddCurrentEditorFile: TAction; actProjectAddFiles: TFileOpen; actProjectSettings: TAction; @@ -139,6 +138,7 @@ TmodActionsMain = class(TDataModule) actToolsWebConfigure: TAction; actToolsWebStartServer: TAction; actToolsWebStopServer: TAction; + actProjectOpenFolder: TBrowseForFolder; procedure actFileNewExecute(Sender: TObject); procedure DataModuleCreate(Sender: TObject); procedure actFileOpenAccept(Sender: TObject); @@ -169,11 +169,9 @@ TmodActionsMain = class(TDataModule) procedure actToolsOptionsExecute(Sender: TObject); procedure actToolsVirtualKeyIdentifierExecute(Sender: TObject); procedure actProjectNewExecute(Sender: TObject); - procedure actProjectSaveAsBeforeExecute(Sender: TObject); procedure actProjectAddCurrentEditorFileExecute(Sender: TObject); procedure actProjectSettingsExecute(Sender: TObject); procedure actProjectOpenAccept(Sender: TObject); - procedure actProjectSaveAsAccept(Sender: TObject); procedure actProjectAddFilesAccept(Sender: TObject); procedure actProjectAddCurrentEditorFileUpdate(Sender: TObject); procedure actHelpContentsExecute(Sender: TObject); @@ -224,12 +222,9 @@ TmodActionsMain = class(TDataModule) procedure actViewCharacterIdentifierExecute(Sender: TObject); // I4807 procedure actViewCharacterIdentifierUpdate(Sender: TObject); procedure actFileSaveAsSaveDialogCanClose(Sender: TObject; - var CanClose: Boolean); - procedure actProjectSaveAsSaveDialogCanClose(Sender: TObject; var CanClose: Boolean); // I4807 procedure actProjectCloseExecute(Sender: TObject); procedure actProjectCloseUpdate(Sender: TObject); - procedure actProjectSaveAsUpdate(Sender: TObject); procedure actProjectAddFilesUpdate(Sender: TObject); procedure actProjectSettingsUpdate(Sender: TObject); procedure actFileNewUpdate(Sender: TObject); @@ -243,12 +238,12 @@ TmodActionsMain = class(TDataModule) procedure actToolsWebStartServerUpdate(Sender: TObject); procedure actToolsWebStopServerExecute(Sender: TObject); procedure actToolsWebStopServerUpdate(Sender: TObject); + procedure actProjectOpenFolderAccept(Sender: TObject); private function CheckFilenameConventions(FileName: string): Boolean; function SaveAndCloseAllFiles: Boolean; procedure CloseProject; public - procedure NewProject(pt: TProjectType); procedure OpenProject(FileName: WideString); end; @@ -540,8 +535,12 @@ procedure TmodActionsMain.actProjectAddCurrentEditorFileExecute( procedure TmodActionsMain.actProjectAddCurrentEditorFileUpdate(Sender: TObject); begin + actProjectAddCurrentEditorFile.Visible := + not IsGlobalProjectUIReady or + (FGlobalProject.Options.Version = pv10); actProjectAddCurrentEditorFile.Enabled := IsGlobalProjectUIReady and + (FGlobalProject.Options.Version = pv10) and Assigned(frmKeymanDeveloper.ActiveEditor) and not frmKeymanDeveloper.ActiveEditor.Untitled and (not Assigned(frmKeymanDeveloper.ActiveEditor.ProjectFile) or @@ -561,7 +560,11 @@ procedure TmodActionsMain.actProjectAddFilesAccept(Sender: TObject); procedure TmodActionsMain.actProjectAddFilesUpdate(Sender: TObject); begin - actProjectAddFiles.Enabled := IsGlobalProjectUIReady; + actProjectAddFiles.Visible := + not IsGlobalProjectUIReady or + (FGlobalProject.Options.Version = pv10); + actProjectAddFiles.Enabled := IsGlobalProjectUIReady and + (FGlobalProject.Options.Version = pv10); end; procedure TmodActionsMain.actProjectCloseExecute(Sender: TObject); @@ -588,10 +591,17 @@ procedure TmodActionsMain.actProjectOpenAccept(Sender: TObject); OpenProject(actProjectOpen.Dialog.FileName); end; +procedure TmodActionsMain.actProjectOpenFolderAccept(Sender: TObject); +begin + if not frmKeymanDeveloper.BeforeOpenProject then + Exit; + OpenProject(actProjectOpenFolder.Folder); +end; + procedure TmodActionsMain.OpenProject(FileName: WideString); begin FileName := ExpandUNCFileName(FileName); - if (FileName <> '') and not FileExists(FileName) then + if (FileName <> '') and not FileExists(FileName) and not DirectoryExists(FileName) then begin ShowMessage('The project '+FileName+' does not exist.'); Exit; @@ -608,18 +618,6 @@ procedure TmodActionsMain.OpenProject(FileName: WideString); frmKeymanDeveloper.UpdateCaption; end; -procedure TmodActionsMain.NewProject(pt: TProjectType); -begin - if IsGlobalProjectUIReady then - begin - if not SaveAndCloseAllFiles then Exit; - FreeGlobalProjectUI; - end; - NewGlobalProjectUI(pt); - frmKeymanDeveloper.ShowProject; - frmKeymanDeveloper.UpdateCaption; -end; - procedure TmodActionsMain.CloseProject; begin if IsGlobalProjectUIReady then @@ -631,29 +629,6 @@ procedure TmodActionsMain.CloseProject; frmKeymanDeveloper.UpdateCaption; end; -procedure TmodActionsMain.actProjectSaveAsAccept(Sender: TObject); -begin - FGlobalProject.FileName := actProjectSaveAs.Dialog.FileName; - FGlobalProject.Save; - frmKeymanDeveloper.ProjectMRU.Add(FGlobalProject.FileName); -end; - -procedure TmodActionsMain.actProjectSaveAsBeforeExecute(Sender: TObject); -begin - actProjectSaveAs.Dialog.FileName := FGlobalProject.FileName; -end; - -procedure TmodActionsMain.actProjectSaveAsSaveDialogCanClose(Sender: TObject; - var CanClose: Boolean); -begin - CanClose := CheckFilenameConventions((Sender as TSaveDialog).FileName); -end; - -procedure TmodActionsMain.actProjectSaveAsUpdate(Sender: TObject); -begin - actProjectSaveAs.Enabled := IsGlobalProjectUIReady; -end; - procedure TmodActionsMain.actProjectSettingsExecute(Sender: TObject); begin with TfrmProjectSettings.Create(Screen.ActiveForm) do // I4688 diff --git a/developer/src/tike/dialogs/UfrmNew.pas b/developer/src/tike/dialogs/UfrmNew.pas index ecb0adea702..e00ed26fb74 100644 --- a/developer/src/tike/dialogs/UfrmNew.pas +++ b/developer/src/tike/dialogs/UfrmNew.pas @@ -217,9 +217,7 @@ procedure TfrmNew.FormCreate(Sender: TObject); i: Integer; begin inherited; - if FGlobalProject.Untitled - then FRootPath := FKeymanDeveloperOptions.DefaultProjectPath - else FRootPath := ExtractFilePath(FGlobalProject.FileName); + FRootPath := ExtractFilePath(FGlobalProject.FileName); lvItems.Selected := lvItems.Items[0]; lvItems.ItemFocused := lvItems.Items[0]; diff --git a/developer/src/tike/main/UfrmMain.dfm b/developer/src/tike/main/UfrmMain.dfm index 436cc9d2477..69e5beca174 100644 --- a/developer/src/tike/main/UfrmMain.dfm +++ b/developer/src/tike/main/UfrmMain.dfm @@ -2935,8 +2935,8 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper object OpenProject1: TMenuItem Action = modActionsMain.actProjectOpen end - object SaveProjectAs1: TMenuItem - Action = modActionsMain.actProjectSaveAs + object OpenProjectFolder1: TMenuItem + Action = modActionsMain.actProjectOpenFolder end object CloseProject1: TMenuItem Action = modActionsMain.actProjectClose @@ -2950,7 +2950,7 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper object N26: TMenuItem Caption = '-' end - object Addtoproject1: TMenuItem + object mnuProjectAddToProject: TMenuItem Caption = 'A&dd to project' object CurrentEditorFile1: TMenuItem Action = modActionsMain.actProjectAddCurrentEditorFile diff --git a/developer/src/tike/main/UfrmMain.pas b/developer/src/tike/main/UfrmMain.pas index 97cd169f8bd..a988a15f1fa 100644 --- a/developer/src/tike/main/UfrmMain.pas +++ b/developer/src/tike/main/UfrmMain.pas @@ -208,12 +208,11 @@ TfrmKeymanDeveloper = class(TTikeForm, IUnicodeDataUIManager, IDragDrop) CodeFont1: TMenuItem; NewProject1: TMenuItem; OpenProject1: TMenuItem; - SaveProjectAs1: TMenuItem; N25: TMenuItem; mnuProjectsRecent: TMenuItem; N26: TMenuItem; N27: TMenuItem; - Addtoproject1: TMenuItem; + mnuProjectAddToProject: TMenuItem; CurrentEditorFile1: TMenuItem; OtherFiles1: TMenuItem; ProjectSettings1: TMenuItem; @@ -285,6 +284,7 @@ TfrmKeymanDeveloper = class(TTikeForm, IUnicodeDataUIManager, IDragDrop) Stopserver1: TMenuItem; ToolButton13: TToolButton; ToolButton16: TToolButton; + OpenProjectFolder1: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure mnuFileClick(Sender: TObject); @@ -550,10 +550,11 @@ procedure TfrmKeymanDeveloper.FormCreate(Sender: TObject); RemoveOldestTikeTestFonts(False); if (FActiveProject <> '') and not FileExists(FActiveProject) then + // TODO: we need to support folder-based projects here FActiveProject := ''; if FActiveProject <> '' then - LoadGlobalProjectUI(ptUnknown, FActiveProject, True); + LoadGlobalProjectUI(ptUnknown, FActiveProject); InitDock; @@ -629,10 +630,7 @@ procedure TfrmKeymanDeveloper.DoCloseCleanup; begin if IsGlobalProjectUIReady then begin - if FGlobalProject.Untitled - then FGlobalProject.PersistUntitledProject // I1010: Persist untitled project - else FGlobalProject.Save; // I4691 - + FGlobalProject.Save; // I4691 WriteString(SRegValue_ActiveProject, FGlobalProject.FileName); end else @@ -1159,8 +1157,16 @@ function TfrmKeymanDeveloper.OpenFile(FFileName: string; FCloseNewFile: Boolean) begin if not IsGlobalProjectUIReady then begin + // TODO: we need to open the parent folder as a project, if possible // This can happen if we get a file opened via Explorer. - modActionsMain.NewProject(ptKeyboard); + ShowMessage('TODO -- open parent folder as project'); + Exit(nil); + end; + + if DirectoryExists(FFileName) then + begin + // This is an attempt to open a project folder? + // TODO end; Result := nil; @@ -1426,6 +1432,9 @@ procedure TfrmKeymanDeveloper.mnuProjectClick(Sender: TObject); end; mnuProjectsRecent.Enabled := FProjectMRU.FileCount > 0; + + mnuProjectAddToProject.Visible := not IsGlobalProjectUIReady or + (FGlobalProject.Options.Version = pv10); end; procedure TfrmKeymanDeveloper.mnuProjectRecentFileClick(Sender: TObject); @@ -1520,9 +1529,8 @@ procedure TfrmKeymanDeveloper.UpdateCaption; begin if not IsGlobalProjectUIReady then Caption := 'Keyman Developer' - else if FGlobalProject.Untitled - then Caption := '(Untitled project) - Keyman Developer' - else Caption := ChangeFileExt(ExtractFileName(FGlobalProject.FileName), '') + ' - Keyman Developer'; + else + Caption := ChangeFileExt(ExtractFileName(FGlobalProject.FileName), '') + ' - Keyman Developer'; end; procedure TfrmKeymanDeveloper.UpdateChildCaption(Window: TfrmTikeChild); diff --git a/developer/src/tike/project/Keyman.Developer.System.Project.ProjectFile.pas b/developer/src/tike/project/Keyman.Developer.System.Project.ProjectFile.pas index 66b858a3ba7..46ebcdc47d0 100644 --- a/developer/src/tike/project/Keyman.Developer.System.Project.ProjectFile.pas +++ b/developer/src/tike/project/Keyman.Developer.System.Project.ProjectFile.pas @@ -82,6 +82,58 @@ interface TempFileManager, utilfiletypes; +type + TProjectState = (psCreating, psReady, psLoading, psSaving, psDestroying); + TProjectType = (ptUnknown, ptKeyboard, ptLexicalModel); // distinct from utilfiletypes.TKeymanProjectType + + TProjectVersion = (pv10, pv20); + + TProjectOptionsRecord = record + BuildPath: string; + SourcePath: string; + CompilerWarningsAsErrors: Boolean; + WarnDeprecatedCode: Boolean; + CheckFilenameConventions: Boolean; + SkipMetadataFiles: Boolean; + ProjectType: TProjectType; + Version: TProjectVersion; + end; + + TProjectOptions = class + BuildPath: string; + SourcePath: string; + CompilerWarningsAsErrors: Boolean; + WarnDeprecatedCode: Boolean; + CheckFilenameConventions: Boolean; + SkipMetadataFiles: Boolean; + ProjectType: TProjectType; + Version: TProjectVersion; + public + procedure Assign(source: TProjectOptions); overload; + procedure Assign(source: TProjectOptionsRecord); overload; + function EqualsRecord(source: TProjectOptionsRecord): Boolean; + end; + +const DefaultProjectOptions: array[TProjectVersion] of TProjectOptionsRecord = (( + BuildPath: ''; + SourcePath: ''; + CompilerWarningsAsErrors: False; + WarnDeprecatedCode: True; + CheckFilenameConventions: False; + SkipMetadatafiles: True; + ProjectType: ptKeyboard; + Version: pv10 +), ( + BuildPath: '$PROJECTPATH/build'; + SourcePath: '$PROJECTPATH/source'; + CompilerWarningsAsErrors: False; + WarnDeprecatedCode: True; + CheckFilenameConventions: False; + SkipMetadatafiles: False; + ProjectType: ptKeyboard; + Version: pv20 +)); + type { Forward declarations } @@ -90,10 +142,6 @@ interface TProjectFileList = class; TProjectFile = class; TProjectFileStates = class; - TProjectOptions = class; - - TProjectState = (psCreating, psReady, psLoading, psSaving, psDestroying); - TProjectType = (ptUnknown, ptKeyboard, ptLexicalModel); // distinct from utilfiletypes.TKeymanProjectType { TProject } @@ -111,51 +159,55 @@ TProject = class FDisplayState: WideString; FMRU: TMRUList; FOptions: TProjectOptions; + FUpgradeMessages: TStrings; - procedure SetFileName(Value: string); function ImportFromIni(FileName: string): Boolean; function LoadFromXML(FileName: string): Boolean; function ExpandMemberFileName(Root, FileName: string): string; - function GetSavedFileName: string; - function GetUntitled: Boolean; //procedure ChildRefresh(Sender: TObject); procedure ListNotify(Item: TProjectFile; Action: TListNotification); procedure ChildRefresh(Sender: TObject); procedure MRUChange(Sender: TObject); procedure UpdateFileParameters; - procedure LoadPersistedUntitledProject; - function GetSavedUserFileName: string; + function GetUserFileName: string; + function ResolveProjectPath(APath: string): string; + procedure PopulateFolder(const path: string); + function GetTargetFilename10(ATargetFile, ASourceFile, + AVersion: string): string; + function GetTargetFilename20(ATargetFile, ASourceFile, + AVersion: string): string; protected procedure DoRefresh; virtual; procedure DoRefreshCaption; virtual; property State: TProjectState read FState; - property SavedFileName: string read GetSavedFileName; - property SavedUserFileName: string read GetSavedUserFileName; public procedure Log(AState: TProjectLogState; Filename, Msg: string; MsgCode, line: Integer); virtual; - constructor Create(AProjectType: TProjectType; AFileName: string; ALoadPersistedUntitledProject: Boolean = False); virtual; + constructor Create(AProjectType: TProjectType; AFileName: string); virtual; destructor Destroy; override; procedure Refresh; - procedure PersistUntitledProject; - function Render: WideString; + function IsDefaultProject(Version: TProjectVersion): Boolean; + function Load: Boolean; virtual; // I4694 function Save: Boolean; virtual; // I4694 function SaveUser: Boolean; virtual; // I4694 + function PopulateFiles: Boolean; class function StandardTemplatePath: string; class function StringsTemplatePath: string; - class function GetUntitledProjectFilename(CurrentProcess: Boolean): string; - function GetTargetFilename(ATargetFile, ASourceFile, AVersion: string): string; // I4688 + function CanUpgrade: Boolean; + function Upgrade: Boolean; + property UpgradeMessages: TStrings read FUpgradeMessages; + //procedure AddMRU(const FFileName: string); property MRU: TMRUList read FMRU; @@ -163,9 +215,8 @@ TProject = class function FindFile(AFileName: string): TProjectFile; - //property StandardTemplatePath: string read GetStandardTemplatePath; - property FileName: string read FFileName write SetFileName; - property Untitled: Boolean read GetUntitled; + property FileName: string read FFileName; + property UserFileName: string read GetUserFileName; property Files: TProjectFileList read FFiles; property DisplayState: WideString read FDisplayState write FDisplayState; @@ -288,22 +339,6 @@ TProjectFileStates = class(TObjectList) procedure ProjectFileDestroying(ProjectFile: TProjectFile); end; - TProjectOptions = class // I4688 - private - FBuildPath: string; - FWarnDeprecatedCode: Boolean; // I4866 - FCompilerWarningsAsErrors: Boolean; // I4865 - FCheckFilenameConventions: Boolean; - FProjectType: TProjectType; - public - constructor Create; - property BuildPath: string read FBuildPath write FBuildPath; - property WarnDeprecatedCode: Boolean read FWarnDeprecatedCode write FWarnDeprecatedCode; // I4866 - property CompilerWarningsAsErrors: Boolean read FCompilerWarningsAsErrors write FCompilerWarningsAsErrors; // I4865 - property CheckFilenameConventions: Boolean read FCheckFilenameConventions write FCheckFilenameConventions; - property ProjectType: TProjectType read FProjectType write FProjectType; - end; - const WM_USER_ProjectUpdateDisplayState = WM_USER; @@ -311,6 +346,8 @@ function GlobalProjectStateWndHandle: THandle; function ProjectTypeFromString(s: string): TProjectType; function ProjectTypeToString(pt: TProjectType): string; +function ProjectVersionFromString(s: string): TProjectVersion; +function ProjectVersionToString(pv: TProjectVersion): string; implementation @@ -680,11 +717,17 @@ procedure TProject.ChildRefresh(Sender: TObject); end; end; -constructor TProject.Create(AProjectType: TProjectType; AFileName: string; ALoadPersistedUntitledProject: Boolean = False); +constructor TProject.Create(AProjectType: TProjectType; AFileName: string); var i: Integer; begin - FOptions := TProjectOptions.Create; // I4688 + Assert(AFileName <> ''); + + FUpgradeMessages := TStringList.Create; + + // Assumes v1.0 by default + FOptions := TProjectOptions.Create; + FOptions.Assign(DefaultProjectOptions[pv10]); if AProjectType = ptUnknown then FOptions.ProjectType := ptKeyboard @@ -702,19 +745,9 @@ constructor TProject.Create(AProjectType: TProjectType; AFileName: string; ALoad FMustSave := False; - if (FFileName = '') and (ALoadPersistedUntitledProject) then - begin - FMustSave := True; - LoadPersistedUntitledProject; // I1010: Persist untitled project - end - else if not Load then // I4703 + if not Load then // I4703 begin - FFileName := ''; - if not Load then - begin - FMustSave := True; - LoadPersistedUntitledProject; // I4703 - end; + raise EProjectLoader.Create('Unable to load project '+FFileName); end; FBusy := True; @@ -734,6 +767,7 @@ destructor TProject.Destroy; FState := psDestroying; FFiles.Free; FMRU.Free; + FreeandNil(FUpgradeMessages); FreeAndNil(FOptions); // I4688 inherited Destroy; end; @@ -746,12 +780,6 @@ procedure TProject.DoRefreshCaption; // I4687 begin end; -procedure TProject.SetFileName(Value: string); -begin - FFileName := Value; - DoRefreshCaption; // I4687 -end; - procedure TProject.ListNotify(Item: TProjectFile; Action: TListNotification); begin if FState = psReady then @@ -776,9 +804,9 @@ function TProject.Load: Boolean; FState := psLoading; try SetLength(buf, 32); - if FileExists(SavedFileName) then + if FileExists(FileName) then begin - with TFileStream.Create(SavedFileName, fmOpenRead) do + with TFileStream.Create(FileName, fmOpenRead) do try Read(buf[0], 32); // I3310 finally @@ -786,11 +814,12 @@ function TProject.Load: Boolean; end; if (buf[0] = Ord('<')) or ((TEncoding.GetBufferEncoding(buf, encoding) > 0) and (encoding = TEncoding.UTF8)) // I3310, I3473 - then Result := LoadFromXML(SavedFileName) - else Result := ImportFromIni(SavedFileName); + then Result := LoadFromXML(FileName) + else Result := ImportFromIni(FileName); end - else if DirectoryExists(ExtractFilePath(SavedFileName)) then - Result := Save { Create a temporary project file } + else if DirectoryExists(ExtractFilePath(FileName)) then + // This will fall back to a 2.0 folder load + Result := LoadFromXML(FileName) else begin Result := False; @@ -803,40 +832,11 @@ function TProject.Load: Boolean; end; end; -// I1010: Persist untitled project - begin - -procedure TProject.LoadPersistedUntitledProject; -begin - FFileName := TProject.GetUntitledProjectFilename(False); - try - Load; - finally - FFileName := ''; - end; -end; - procedure TProject.Log(AState: TProjectLogState; Filename, Msg: string; MsgCode, line: Integer); begin // Do nothing end; -procedure TProject.PersistUntitledProject; -var - path: string; -begin - path := TProject.GetUntitledProjectFilename(False); - - FState := psSaving; - with TProjectSaver.Create(Self, path) do - try - Execute; - finally - Free; - end; - - FState := psReady; -end; - procedure TProject.Refresh; // I4687 begin DoRefresh; @@ -847,8 +847,22 @@ function TProject.Render: WideString; doc, userdoc, xsl: IXMLDomDocument; FLastDir: string; i: Integer; + saver: TProjectSaver; + xml, xmluser: string; begin - if not FileExists(SavedFileName) then Save; + FState := psSaving; + try + saver := TProjectSaver.Create(Self, ''); + try + saver.Execute; + xml := saver.XML; + xmluser := saver.XMLUser; + finally + saver.Free; + end; + finally + FState := psReady; + end; Result := ''; FLastDir := GetCurrentDir; @@ -857,24 +871,21 @@ function TProject.Render: WideString; doc := MSXMLDOMDocumentFactory.CreateDOMDocument; try doc.async := False; - doc.load(SavedFileName); + doc.loadXML(xml); // // Inject the user settings to the loaded file // - if FileExists(SavedUserFileName) then // I4698 - begin - userdoc := MSXMLDOMDocumentFactory.CreateDOMDocument; - try - userdoc.async := False; - userdoc.load(SavedUserFileName); - - for i := 0 to userdoc.documentElement.childNodes.length - 1 do - doc.documentElement.appendChild(userdoc.documentElement.childNodes.item[i].cloneNode(true)); - finally - userdoc := nil; - end; + userdoc := MSXMLDOMDocumentFactory.CreateDOMDocument; + try + userdoc.async := False; + userdoc.loadXML(xmluser); + + for i := 0 to userdoc.documentElement.childNodes.length - 1 do + doc.documentElement.appendChild(userdoc.documentElement.childNodes.item[i].cloneNode(true)); + finally + userdoc := nil; end; // @@ -901,7 +912,169 @@ function TProject.Render: WideString; end; end; -// I1010: Persist untitled project - end +function ReadUtf8FileText(const filename: string): string; +var + ss: TStringStream; +begin + ss := TStringStream.Create('', TEncoding.UTF8); + try + ss.LoadFromFile(filename); + Result := ss.DataString; + finally + ss.Free; + end; +end; + +function IsKeymanFile(filename: string): Boolean; +begin + filename := filename.ToLower; + Result := + filename.EndsWith('.model.ts') or +// filename.EndsWith('.kpj') or + filename.EndsWith('.kmn') or + filename.EndsWith('.xml') or + filename.EndsWith('.kps') or + filename.EndsWith('.kvks') or + filename.EndsWith('.keyman-touch-layout'); +end; + +function TProject.IsDefaultProject(Version: TProjectVersion): Boolean; +begin + Result := FOptions.EqualsRecord(DefaultProjectOptions[Version]); +end; + +/// +/// Adds all files in project folder to the in-memory project data +/// @param projectFilename Full path to project.kpj (even if the file doesn't exist) +/// +/// +function TProject.PopulateFiles: Boolean; +var + SourcePath: string; +begin + if FOptions.Version <> pv20 then + raise EProjectLoader.Create('PopulateFiles can only be called on a v2.0 project'); + + SourcePath := ExtractFilePath(FileName); + if not DirectoryExists(SourcePath) then + Exit(False); + + PopulateFolder(SourcePath); + + Result := True; +end; + +procedure TProject.PopulateFolder(const path: string); +var + ff: string; + f: TSearchRec; +begin + if FindFirst(path + '*', faDirectory, f) = 0 then + begin + repeat + ff := path + f.Name; + + if (f.Name = '.') or (f.Name = '..') then + begin + Continue; + end; + + if (f.Attr and faDirectory) = faDirectory then + begin + PopulateFolder(ff + '\'); + Continue; + end; + + CreateProjectFile(Self, ff, nil); + until FindNext(f) <> 0; + System.SysUtils.FindClose(f); + end; +end; + +{ +function IsLMDLKeyboardFile(filename: string): Boolean; + if EndsText('.xml', filename) then + begin + Result := Pos('ldmlKeyboard.dtd', ReadUtf8FileText(ff)) > 0; + end + else + Result := False; +end; +} + +function TProject.CanUpgrade: Boolean; +var + i: Integer; + Path: string; +begin + if FOptions.Version = pv20 then + begin + Exit(False); + end; + + FUpgradeMessages.Clear; + Result := True; + + // Things that block upgrade: + // 1. invalid paths in Options + // 2. contained file paths outside the project folder (primary files only) + + if Options.BuildPath.Contains('$SOURCEPATH') then + begin + Result := False; + FUpgradeMessages.Add('The BuildPath option contains "$SOURCEPATH"'); + end; + if Options.BuildPath.Contains('$VERSION') then + begin + Result := False; + FUpgradeMessages.Add('The BuildPath option contains "$VERSION"'); + end; + + for i := 0 to Files.Count - 1 do + begin + if Assigned(Files[i].Parent) then + begin + Continue; + end; + + Path := ExtractRelativePath(FileName, Files[i].FileName); + if IsRelativePath(Path) and not Path.StartsWith('..') then + begin + // Path is in same folder or a subfolder of the project + Continue; + end; + + FUpgradeMessages.Add('File '+Files[i].FileName+' is outside the project folder'); + Result := False; + end; +end; + +function TProject.Upgrade: Boolean; +var + i: Integer; +begin + if Options.Version = pv20 then + raise Exception.Create('Unexpected: Upgrade was called when already version 2.0'); + + if not CanUpgrade then + raise Exception.Create('Unexpected: Upgrade was called when CanUpgrade=False'); + + Options.Version := pv20; + + for i := Files.Count - 1 downto 0 do + begin + if Assigned(Files[i].Parent) then + begin + Files.Delete(i); + end; + end; + + Save; + + PopulateFiles; + + Result := True; +end; function TProject.LoadFromXML(FileName: string): Boolean; begin @@ -972,7 +1145,7 @@ function TProject.Save: Boolean; begin FState := psSaving; try - with TProjectSaver.Create(Self, SavedFileName) do + with TProjectSaver.Create(Self, FileName) do try Execute; finally @@ -989,7 +1162,7 @@ function TProject.SaveUser: Boolean; begin FState := psSaving; try - with TProjectSaver.Create(Self, SavedFileName) do + with TProjectSaver.Create(Self, FileName) do try SaveUser; finally @@ -1002,19 +1175,17 @@ function TProject.SaveUser: Boolean; Result := True; end; -function TProject.GetSavedFileName: string; +function TProject.GetUserFileName: string; begin - if FFileName = '' - then Result := TProject.GetUntitledProjectFilename(True) // I4181 - else Result := FFileName; + Result := ChangeFileExt(FileName, Ext_ProjectSourceUser); end; -function TProject.GetSavedUserFileName: string; +function TProject.ResolveProjectPath(APath: string): string; begin - Result := ChangeFileExt(SavedFileName, Ext_ProjectSourceUser); + Result := ReplaceText(APath, '$PROJECTPATH', ExtractFileDir(ExpandFileName(FFileName))); end; -function TProject.GetTargetFilename(ATargetFile, ASourceFile, AVersion: string): string; // I4688 +function TProject.GetTargetFilename10(ATargetFile, ASourceFile, AVersion: string): string; // I4688 begin Result := Trim(Options.BuildPath); if Result = '' then Result := '$SOURCEPATH'; @@ -1022,14 +1193,32 @@ function TProject.GetTargetFilename(ATargetFile, ASourceFile, AVersion: string): // Replace placeholders in the target path Result := ReplaceText(Result, '$SOURCEPATH', ExtractFileDir(ExpandFileName(ASourceFile))); - if FFileName = '' // if we have an unsaved project, use the source path for project path - then Result := ReplaceText(Result, '$PROJECTPATH', ExtractFileDir(ExpandFileName(ASourceFile))) - else Result := ReplaceText(Result, '$PROJECTPATH', ExtractFileDir(ExpandFileName(FFileName))); + Result := ReplaceText(Result, '$PROJECTPATH', ExtractFileDir(ExpandFileName(FFileName))); Result := ReplaceText(Result, '$VERSION', AVersion); Result := Result + ExtractFileName(ATargetFile); end; +function TProject.GetTargetFilename20(ATargetFile, ASourceFile, AVersion: string): string; // I4688 +begin + Result := Trim(Options.BuildPath); + if Result = '' then + begin + Exit(ExtractFilePath(ExpandFileName(ASourceFile)) + ExtractFileName(ATargetFile)); + end; + + Result := IncludeTrailingPathDelimiter(Result); + Result := ResolveProjectPath(Result); + Result := Result + ExtractFileName(ATargetFile); +end; + +function TProject.GetTargetFilename(ATargetFile, ASourceFile, AVersion: string): string; // I4688 +begin + if Options.Version = pv10 + then Result := GetTargetFilename10(ATargetFile, ASourceFile, AVersion) + else Result := GetTargetFilename20(ATargetFile, ASourceFile, AVersion); +end; + class function TProject.StandardTemplatePath: string; //(const FileName: string): string; begin Result := StringsTemplatePath; // GetXMLTemplatePath + 'project\'; @@ -1040,13 +1229,6 @@ class function TProject.StringsTemplatePath: string; Result := GetXMLTemplatePath + 'project\'; end; -class function TProject.GetUntitledProjectFilename(CurrentProcess: Boolean): string; -begin - if CurrentProcess - then Result := GetFolderPath(CSIDL_APPDATA) + SFolderKeymanDeveloper + '\Untitled.' + IntToStr(GetCurrentProcessId) + Ext_ProjectSource - else Result := GetFolderPath(CSIDL_APPDATA) + SFolderKeymanDeveloper + '\Untitled' + Ext_ProjectSource; -end; - procedure TProject.UpdateFileParameters; // I4688 // I4710 var i: Integer; @@ -1070,20 +1252,6 @@ procedure TProject.UpdateFileParameters; // I4688 // I4710 end; end; -function TProject.GetUntitled: Boolean; -begin - Result := FFileName = ''; -end; - -{procedure TProject.ChildRefresh(Sender: TObject); -begin - if FState = psReady then - begin - Save; - Refresh; - end; -end;} - function TProject.FindFile(AFileName: string): TProjectFile; var i: Integer; @@ -1149,12 +1317,41 @@ procedure TProjectFileStates.SetItem(Index, Value: WideString); { TProjectOptions } -constructor TProjectOptions.Create; +procedure TProjectOptions.Assign(source: TProjectOptions); +begin + Self.BuildPath := source.BuildPath; + Self.SourcePath := source.SourcePath; + Self.CompilerWarningsAsErrors := source.CompilerWarningsAsErrors; + Self.WarnDeprecatedCode := source.WarnDeprecatedCode; + Self.CheckFilenameConventions := source.CheckFilenameConventions; + Self.SkipMetadataFiles := source.SkipMetadataFiles; + Self.ProjectType := source.ProjectType; + Self.Version := Source.Version; +end; + +procedure TProjectOptions.Assign(source: TProjectOptionsRecord); begin - WarnDeprecatedCode := True; // I4866 - CompilerWarningsAsErrors := False; // I4865 - CheckFilenameConventions := True; // default to TRUE for new projects - ProjectType := ptKeyboard; + Self.BuildPath := source.BuildPath; + Self.SourcePath := source.SourcePath; + Self.CompilerWarningsAsErrors := source.CompilerWarningsAsErrors; + Self.WarnDeprecatedCode := source.WarnDeprecatedCode; + Self.CheckFilenameConventions := source.CheckFilenameConventions; + Self.SkipMetadataFiles := source.SkipMetadataFiles; + Self.ProjectType := source.ProjectType; + Self.Version := Source.Version; +end; + +function TProjectOptions.EqualsRecord(source: TProjectOptionsRecord): Boolean; +begin + Result := + (Self.BuildPath = source.BuildPath) and + (Self.SourcePath = source.SourcePath) and + (Self.CompilerWarningsAsErrors = source.CompilerWarningsAsErrors) and + (Self.WarnDeprecatedCode = source.WarnDeprecatedCode) and + (Self.CheckFilenameConventions = source.CheckFilenameConventions) and + (Self.SkipMetadataFiles = source.SkipMetadataFiles) and + (Self.ProjectType = source.ProjectType) and + (Self.Version = Source.Version); end; type @@ -1232,14 +1429,24 @@ function ProjectTypeToString(pt: TProjectType): string; end; end; +function ProjectVersionFromString(s: string): TProjectVersion; +begin + if SameText(s, '1.0') then Result := pv10 + else if SameText(s, '2.0') then Result := pv20 + else Result := pv10; // TODO is this adequate? +end; + +function ProjectVersionToString(pv: TProjectVersion): string; +begin + case pv of + pv10: Result := '1.0'; + pv20: Result := '2.0'; + end; +end; + initialization FGlobalProjectStateWnd := TGlobalProjectStateWnd.Create; finalization // Deletes temporary session-local project - if FileExists(TProject.GetUntitledProjectFilename(True)) then - System.SysUtils.DeleteFile(TProject.GetUntitledProjectFilename(True)); - if FileExists(ChangeFileExt(TProject.GetUntitledProjectFilename(True),Ext_ProjectSourceUser)) then - System.SysUtils.DeleteFile(ChangeFileExt(TProject.GetUntitledProjectFilename(True),Ext_ProjectSourceUser)); - FGlobalProjectStateWnd.Free; end. diff --git a/developer/src/tike/project/Keyman.Developer.System.Project.ProjectLoader.pas b/developer/src/tike/project/Keyman.Developer.System.Project.ProjectLoader.pas index aff2b243d41..c5b74a49fec 100644 --- a/developer/src/tike/project/Keyman.Developer.System.Project.ProjectLoader.pas +++ b/developer/src/tike/project/Keyman.Developer.System.Project.ProjectLoader.pas @@ -1,18 +1,18 @@ (* Name: Keyman.Developer.System.Project.ProjectLoader Copyright: Copyright (C) SIL International. - Documentation: - Description: + Documentation: + Description: Create Date: 1 Aug 2006 Modified Date: 24 Aug 2015 Authors: mcdurdin - Related Files: - Dependencies: + Related Files: + Dependencies: - Bugs: - Todo: - Notes: + Bugs: + Todo: + Notes: History: 01 Aug 2006 - mcdurdin - Initial version 19 Mar 2007 - mcdurdin - I708 - Files disappearing from project 19 Nov 2007 - mcdurdin - I1157 - const string parameters @@ -22,7 +22,7 @@ 05 May 2015 - mcdurdin - I4698 - V9.0 - Split project and user preferences files 24 Aug 2015 - mcdurdin - I4865 - Add treat hints and warnings as errors into project 24 Aug 2015 - mcdurdin - I4866 - Add warn on deprecated features to project and compile - + *) unit Keyman.Developer.System.Project.ProjectLoader; @@ -38,6 +38,8 @@ interface Keyman.Developer.System.Project.ProjectFile, utilsystem; +// Corresponds to kmc/projectLoader.ts; TypeScript implementation is master version + type EProjectLoader = class(Exception); @@ -45,7 +47,9 @@ TProjectLoader = class private FFileName: string; FProject: TProject; - procedure LoadUser; // I4698 + procedure LoadUser; + procedure LoadDefaultProjectFromFolder; + procedure LoadProjectFromFile; // I4698 public constructor Create(AProject: TProject; AFileName: string); procedure Execute; @@ -73,8 +77,24 @@ constructor TProjectLoader.Create(AProject: TProject; AFileName: string); FFileName := AFileName; end; - procedure TProjectLoader.Execute; // I4698 +begin + if FileExists(FFileName) or (FFileName = '') + then LoadProjectFromFile + else LoadDefaultProjectFromFolder; +end; + +procedure TProjectLoader.LoadDefaultProjectFromFolder; +begin + FProject.Options.Assign(DefaultProjectOptions[pv20]); + if not FProject.PopulateFiles then + // TODO: This seems somewhat arbitrary and troublesome. Better to load the + // folder and give warnings about file layout + raise EProjectLoader.Create('Not a Keyman Developer project folder'); +end; + + +procedure TProjectLoader.LoadProjectFromFile; var n, i: Integer; doc: IXMLDocument; @@ -97,70 +117,88 @@ procedure TProjectLoader.Execute; // I4698 node := root.ChildNodes.FindNode('Options'); // I4688 if node <> nil then begin - FProject.Options.BuildPath := VarToStr(node.ChildValues['BuildPath']); + if not VarIsNull(node.ChildValues['Version']) then + FProject.Options.Version := ProjectVersionFromString(VarToStr(node.ChildValues['Version'])); + + // Set default project options based on what we learned above + FProject.Options.Assign(DefaultProjectOptions[FProject.Options.Version]); + + if not VarIsNull(node.ChildValues['BuildPath']) then + FProject.Options.BuildPath := VarToStr(node.ChildValues['BuildPath']); + + if not VarIsNull(node.ChildValues['SourcePath']) then + FProject.Options.SourcePath := VarToStr(node.ChildValues['SourcePath']); - if VarIsNull(node.ChildValues['CompilerWarningsAsErrors']) // I4865 - then FProject.Options.CompilerWarningsAsErrors := False - else FProject.Options.CompilerWarningsAsErrors := node.ChildValues['CompilerWarningsAsErrors']; + if not VarIsNull(node.ChildValues['CompilerWarningsAsErrors']) then + FProject.Options.CompilerWarningsAsErrors := node.ChildValues['CompilerWarningsAsErrors']; - if VarIsNull(node.ChildValues['WarnDeprecatedCode']) // I4866 - then FProject.Options.WarnDeprecatedCode := True - else FProject.Options.WarnDeprecatedCode := node.ChildValues['WarnDeprecatedCode']; + if not VarIsNull(node.ChildValues['WarnDeprecatedCode']) then + FProject.Options.WarnDeprecatedCode := node.ChildValues['WarnDeprecatedCode']; - if VarIsNull(node.ChildValues['CheckFilenameConventions']) - then FProject.Options.CheckFilenameConventions := False // existing projects default to FALSE (new projects default to TRUE) - else FProject.Options.CheckFilenameConventions := node.ChildValues['CheckFilenameConventions']; + if not VarIsNull(node.ChildValues['CheckFilenameConventions']) then + FProject.Options.CheckFilenameConventions := node.ChildValues['CheckFilenameConventions']; - FProject.Options.ProjectType := ProjectTypeFromString(VarToStr(node.ChildValues['ProjectType'])); - if FProject.Options.ProjectType = ptUnknown then - // Support projects without a defined projecttype - FProject.Options.ProjectType := ptKeyboard; + if not VarIsNull(node.ChildValues['SkipMetadataFiles']) then + FProject.Options.SkipMetadataFiles := node.ChildValues['SkipMetadataFiles']; + + if not VarIsNull(node.ChildValues['ProjectType']) then + begin + FProject.Options.ProjectType := ProjectTypeFromString(VarToStr(node.ChildValues['ProjectType'])); + if FProject.Options.ProjectType = ptUnknown then + // Support projects without a defined projecttype + FProject.Options.ProjectType := ptKeyboard; + end; end; { Load root nodes first - I708 } - for i := 0 to root.ChildNodes['Files'].ChildNodes.Count - 1 do + if FProject.Options.Version = pv10 then begin - node := root.ChildNodes['Files'].ChildNodes[i]; - if node.NodeName <> 'File' then Continue; - if node.ChildNodes.FindNode('ParentFileID') = nil then // ChildValues['ParentFileID'] then + for i := 0 to root.ChildNodes['Files'].ChildNodes.Count - 1 do begin - if not VarIsNull(node.ChildValues['Filepath']) then + node := root.ChildNodes['Files'].ChildNodes[i]; + if node.NodeName <> 'File' then Continue; + if node.ChildNodes.FindNode('ParentFileID') = nil then // ChildValues['ParentFileID'] then begin - // I1152 - Avoid crashes when .kpj file is invalid - pf := CreateProjectFile(FProject, ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), nil); - pf.Load(node, True); + if not VarIsNull(node.ChildValues['Filepath']) then + begin + // I1152 - Avoid crashes when .kpj file is invalid + pf := CreateProjectFile(FProject, ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), nil); + pf.Load(node, True); + end; end; end; - end; - - { Load child nodes } - for i := 0 to root.ChildNodes['Files'].ChildNodes.Count - 1 do - begin - node := root.ChildNodes['Files'].ChildNodes[i]; - if node.NodeName <> 'File' then Continue; + { Load child nodes } - if node.ChildNodes.FindNode('ParentFileID') <> nil then // ChildValues['ParentFileID'] then + for i := 0 to root.ChildNodes['Files'].ChildNodes.Count - 1 do begin - n := FProject.Files.IndexOfID(node.ChildValues['ParentFileID']); - if n < 0 then Continue; - pf := CreateProjectFile(FProject, ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), FProject.Files[n]); - pf.Load(node, True); + node := root.ChildNodes['Files'].ChildNodes[i]; + if node.NodeName <> 'File' then Continue; + + if node.ChildNodes.FindNode('ParentFileID') <> nil then // ChildValues['ParentFileID'] then + begin + n := FProject.Files.IndexOfID(node.ChildValues['ParentFileID']); + if n < 0 then Continue; + pf := CreateProjectFile(FProject, ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), FProject.Files[n]); + pf.Load(node, True); + end; end; - end; - { Load MRU from old project files } + { Load MRU from old project files } - node := root.ChildNodes['MRU']; - if Assigned(node) then - begin - for i := 0 to node.ChildNodes.Count - 1 do + node := root.ChildNodes['MRU']; + if Assigned(node) then begin - if node.ChildNodes[i].NodeName <> 'File' then Continue; - FProject.MRU.Append(node.ChildNodes[i].ChildNodes['FullPath'].NodeValue); + for i := 0 to node.ChildNodes.Count - 1 do + begin + if node.ChildNodes[i].NodeName <> 'File' then Continue; + FProject.MRU.Append(node.ChildNodes[i].ChildNodes['FullPath'].NodeValue); + end; end; - end; + end + else + FProject.PopulateFiles; LoadUser; end; diff --git a/developer/src/tike/project/Keyman.Developer.System.Project.ProjectSaver.pas b/developer/src/tike/project/Keyman.Developer.System.Project.ProjectSaver.pas index 8e5e77a4bd7..ba5f5def502 100644 --- a/developer/src/tike/project/Keyman.Developer.System.Project.ProjectSaver.pas +++ b/developer/src/tike/project/Keyman.Developer.System.Project.ProjectSaver.pas @@ -37,7 +37,7 @@ interface uses System.Classes, - SysUtils, + System.SysUtils, Winapi.Windows, Xml.XMLDoc, Xml.XMLIntf, @@ -52,10 +52,14 @@ TProjectSaver = class private FFileName: string; FProject: TProject; + FXML: string; + FXMLUser: string; public constructor Create(AProject: TProject; AFileName: string); procedure Execute; procedure SaveUser; // I4698 + property XML: string read FXML; + property XMLUser: string read FXMLUser; end; implementation @@ -80,7 +84,17 @@ procedure TProjectSaver.Execute; // I4698 i: Integer; doc: IXMLDocument; node, root: IXMLNode; + defopts: TProjectOptionsRecord; begin + if FProject.IsDefaultProject(pv20) then + begin + if FileExists(FFileName) then + System.SysUtils.DeleteFile(FFileName); + Exit; + end; + + defopts := DefaultProjectOptions[FProject.Options.Version]; + doc := NewXMLDocument(); doc.Options := doc.Options + [doNodeAutoIndent]; // I4704 doc.Encoding := 'utf-8'; @@ -91,19 +105,46 @@ procedure TProjectSaver.Execute; // I4698 // options node := root.AddChild('Options'); // I4688 - node.AddChild('BuildPath').NodeValue := FProject.Options.BuildPath; - node.AddChild('CompilerWarningsAsErrors').NodeValue := FProject.Options.CompilerWarningsAsErrors; // I4866 - node.AddChild('WarnDeprecatedCode').NodeValue := FProject.Options.WarnDeprecatedCode; // I4865 - node.AddChild('CheckFilenameConventions').NodeValue := FProject.Options.CheckFilenameConventions; // I4866 - node.AddChild('ProjectType').NodeValue := ProjectTypeToString(FProject.Options.ProjectType); + if FProject.Options.Version = pv20 then + // Only v2.0 projects have a version number + node.AddChild('Version').NodeValue := ProjectVersionToString(FProject.Options.Version); + + if FProject.Options.BuildPath <> defopts.BuildPath then + node.AddChild('BuildPath').NodeValue := FProject.Options.BuildPath; + + if FProject.Options.SourcePath <> defopts.SourcePath then + node.AddChild('SourcePath').NodeValue := FProject.Options.SourcePath; + + if FProject.Options.CompilerWarningsAsErrors <> defopts.CompilerWarningsAsErrors then + node.AddChild('CompilerWarningsAsErrors').NodeValue := FProject.Options.CompilerWarningsAsErrors; // I4866 + + if FProject.Options.WarnDeprecatedCode <> defopts.WarnDeprecatedCode then + node.AddChild('WarnDeprecatedCode').NodeValue := FProject.Options.WarnDeprecatedCode; // I4865 + + if FProject.Options.CheckFilenameConventions <> defopts.CheckFilenameConventions then + node.AddChild('CheckFilenameConventions').NodeValue := FProject.Options.CheckFilenameConventions; // I4866 + + if FProject.Options.SkipMetadataFiles <> defopts.SkipMetadataFiles then + node.AddChild('SkipMetadataFiles').NodeValue := FProject.Options.SkipMetadataFiles; + + if FProject.Options.ProjectType <> defopts.ProjectType then + node.AddChild('ProjectType').NodeValue := ProjectTypeToString(FProject.Options.ProjectType); // files - node := root.AddChild('Files'); - for i := 0 to FProject.Files.Count - 1 do - FProject.Files[i].Save(node.AddChild('File'), False); + if (FProject.Options.Version = pv10) or (FFileName = '') then + begin + node := root.AddChild('Files'); + for i := 0 to FProject.Files.Count - 1 do + FProject.Files[i].Save(node.AddChild('File'), False); + end; - doc.SaveToFile(FFileName); + if FFileName <> '' then + begin + doc.SaveToFile(FFileName); + end + else + doc.SaveToXML(FXML); SaveUser; end; @@ -153,7 +194,12 @@ procedure TProjectSaver.SaveUser; // I4698 end; end; - doc.SaveToFile(ChangeFileExt(FFileName, Ext_ProjectSourceUser)); + if FFileName <> '' then + begin + doc.SaveToFile(ChangeFileExt(FFileName, Ext_ProjectSourceUser)); + end + else + doc.SaveToXML(FXMLUser); end; end. diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectFileUI.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectFileUI.pas index 6026fb2377e..f850f9a9dad 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectFileUI.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectFileUI.pas @@ -47,7 +47,7 @@ TProjectUI = class(TProject) procedure DoRefreshCaption; override; public - constructor Create(AProjectType: TProjectType; AFileName: string; ALoadPersistedUntitledProject: Boolean = False); override; + constructor Create(AProjectType: TProjectType; AFileName: string); override; destructor Destroy; override; procedure Log(AState: TProjectLogState; Filename, Msg: string; MsgCode, line: Integer); override; // I4706 @@ -129,8 +129,7 @@ procedure TProjectUI.DoRefreshCaption; { TProjectUI } -constructor TProjectUI.Create(AProjectType: TProjectType; AFileName: string; - ALoadPersistedUntitledProject: Boolean); +constructor TProjectUI.Create(AProjectType: TProjectType; AFileName: string); begin inherited; FRenderFileName := TTempFileManager.Get('.html'); // I4181 @@ -144,9 +143,7 @@ destructor TProjectUI.Destroy; function TProjectUI.DisplayFileName: string; begin - if Untitled - then Result := '(untitled project)' - else Result := ExtractFileName(FileName); + Result := ExtractFileName(FileName); end; function TProjectUI.Load: Boolean; // I4694 @@ -185,7 +182,7 @@ function TProjectUI.Render: WideString; FLastDir: string; i: Integer; begin - if not FileExists(SavedFileName) then Save; + if not FileExists(FileName) then Save; Result := FRenderFileName.Name; // I4181 FLastDir := GetCurrentDir; @@ -194,18 +191,18 @@ function TProjectUI.Render: WideString; doc := MSXMLDOMDocumentFactory.CreateDOMDocument; try doc.async := False; - doc.load(SavedFileName); + doc.load(FileName); // // Inject the user settings to the loaded file // - if FileExists(SavedUserFileName) then // I4698 + if FileExists(UserFileName) then // I4698 begin userdoc := MSXMLDOMDocumentFactory.CreateDOMDocument; try userdoc.async := False; - userdoc.load(SavedUserFileName); + userdoc.load(UserFileName); for i := 0 to userdoc.documentElement.childNodes.length - 1 do doc.documentElement.appendChild(userdoc.documentElement.childNodes.item[i].cloneNode(true)); finally diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas index a62ae6ec13a..97e0fb24116 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas @@ -25,8 +25,7 @@ interface Keyman.Developer.UI.Project.ProjectFileUI; function GetGlobalProjectUI: TProjectUI; -function LoadGlobalProjectUI(pt: TProjectType; AFilename: string; ALoadPersistedUntitledProject: Boolean = False): TProjectUI; -function NewGlobalProjectUI(pt: TProjectType): TProjectUI; +function LoadGlobalProjectUI(pt: TProjectType; AFilename: string): TProjectUI; procedure FreeGlobalProjectUI; function IsGlobalProjectUIReady: Boolean; @@ -52,22 +51,17 @@ procedure FreeGlobalProjectUI; FreeAndNil(FGlobalProject); end; -function LoadGlobalProjectUI(pt: TProjectType; AFilename: string; ALoadPersistedUntitledProject: Boolean = False): TProjectUI; +function LoadGlobalProjectUI(pt: TProjectType; AFilename: string): TProjectUI; begin Assert(not Assigned(FGlobalProject)); - Result := TProjectUI.Create(pt, AFilename, ALoadPersistedUntitledProject); // I4687 - FGlobalProject := Result; -end; - -function NewGlobalProjectUI(pt: TProjectType): TProjectUI; -var - FSessionUntitledProjectFilename: string; -begin - Assert(not Assigned(FGlobalProject)); - FSessionUntitledProjectFilename := TProject.GetUntitledProjectFilename(True); - if FileExists(FSessionUntitledProjectFilename) then - DeleteFile(FSessionUntitledProjectFilename); - Result := TProjectUI.Create(pt, '', False); // I4687 + if DirectoryExists(AFilename) then + begin + // Load a directory-based project + if AFilename.EndsWith('\') then + AFilename := AFilename.Substring(0, AFilename.Length-1); + AFilename := AFilename + '\' + ExtractFileName(AFilename) + '.kpj'; + end; + Result := TProjectUI.Create(pt, AFilename); // I4687 FGlobalProject := Result; end; diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.dfm b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.dfm index 9d3c9b9ad6c..d14234be724 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.dfm +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.dfm @@ -42,15 +42,12 @@ inherited frmNewProject: TfrmNewProject FullDrag = True HideSelection = False Items.ItemData = { - 05160100000500000001000000FFFFFFFFFFFFFFFF00000000FFFFFFFF000000 - 00054200610073006900630000000000FFFFFFFFFFFFFFFF00000000FFFFFFFF - 000000000542006C0061006E006B0002000000FFFFFFFFFFFFFFFF00000000FF - FFFFFF000000001657006F00720064006C0069007300740020004C0065007800 - 6900630061006C0020004D006F00640065006C0000000000FFFFFFFFFFFFFFFF - 00000000FFFFFFFF000000001342006C0061006E006B0020004C006500780069 - 00630061006C0020004D006F00640065006C0000000000FFFFFFFFFFFFFFFF00 - 000000FFFFFFFF000000001749006D0070006F00720074002000570069006E00 - 64006F007700730020004B006500790062006F00610072006400} + 05B20000000300000001000000FFFFFFFFFFFFFFFF00000000FFFFFFFF000000 + 00054200610073006900630002000000FFFFFFFFFFFFFFFF00000000FFFFFFFF + 000000001657006F00720064006C0069007300740020004C0065007800690063 + 0061006C0020004D006F00640065006C0000000000FFFFFFFFFFFFFFFF000000 + 00FFFFFFFF000000001749006D0070006F00720074002000570069006E006400 + 6F007700730020004B006500790062006F00610072006400} LargeImages = ilLarge SmallImages = ilSmall TabOrder = 0 @@ -86,7 +83,7 @@ inherited frmNewProject: TfrmNewProject Left = 56 Top = 292 Bitmap = { - 494C010103000800400020002000FFFFFF002110FFFFFFFFFFFFFFFF424D3600 + 494C010103000800040020002000FFFFFF002110FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000800000002000000001002000000000000040 0000000000000000000000000000000000000000000000000000000000000000 00004D4D4DAFB2B2B1F9B2B2B1F9B1B1B0F8B1B1B0F8B1B1B0F8B1B1B0F8B1B1 @@ -628,7 +625,7 @@ inherited frmNewProject: TfrmNewProject Left = 18 Top = 292 Bitmap = { - 494C010103000800400010001000FFFFFF002110FFFFFFFFFFFFFFFF424D3600 + 494C010103000800040010001000FFFFFF002110FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 000000000000000000000000000000000000000000003F3F3F97C8C8C8FBC8C8 C8FBC8C8C8FBC8C8C8FBC8C8C8FBC8C8C8FBC8C8C8FBC8C8C8FBC8C8C8FBC8C8 diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.pas index f1dfe559d0e..39fb79eeaa5 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProject.pas @@ -110,16 +110,6 @@ function ShowNewProjectForm(Owner: TComponent): Boolean; Result := ShowNewProjectParameters(Owner); kptWordlistLexicalModel: Result := ShowNewModelProjectParameters(Owner); - kptBlankLexicalModel: - begin - modActionsMain.NewProject(ptLexicalModel); - Result := True; - end; - kptBlank: - begin - modActionsMain.NewProject(ptKeyboard); - Result := True; - end; kptImportWindowsKeyboard: Result := ShowImportWindowsKeyboard(Owner); end; @@ -152,12 +142,8 @@ function TfrmNewProject.GetProjectType: TKeymanProjectType; Result := kptUnknown else if lvItems.Selected.Caption = 'Basic' then Result := kptBasic - else if lvItems.Selected.Caption = 'Blank' then - Result := kptBlank else if lvItems.Selected.Caption = 'Import Windows Keyboard' then Result := kptImportWindowsKeyboard - else if lvItems.Selected.Caption = 'Blank Lexical Model' then - Result := kptBlankLexicalModel else if lvItems.Selected.Caption = 'Wordlist Lexical Model' then Result := kptWordlistLexicalModel else @@ -190,13 +176,9 @@ procedure TfrmNewProject.UpdateDescription; 'Creates a keyboard project that matches the folder structure used in '+ 'the Keyman keyboards repository and includes all basic files '+ 'needed for a keyboard project.'; - kptBlank: lblDescription.Caption := - 'Creates a blank, untitled keyboard project.'; kptImportWindowsKeyboard: lblDescription.Caption := 'Creates a new keyboard project, importing from a Windows system keyboard '+ 'and generating all the basic files needed for a keyboard project.'; - kptBlankLexicalModel: lblDescription.Caption := - 'Creates a blank, untitled lexical model project.'; kptWordlistLexicalModel: lblDescription.Caption := 'Creates a new lexical model project that matches the folder structure used in '+ 'the Keyman lexical-models repository and includes all basic files '+ diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmProject.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmProject.pas index 992a4491c36..3ce825b5a64 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmProject.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmProject.pas @@ -112,6 +112,7 @@ implementation Keyman.Developer.System.Project.Project, Keyman.Developer.UI.Project.ProjectUI, Keyman.Developer.UI.Project.ProjectFileUI, + keyman.Developer.UI.Project.UpgradeProject, Keyman.Developer.System.Project.ProjectFileType, typinfo, ErrorControlledRegistry, @@ -343,6 +344,8 @@ procedure TfrmProject.WebCommandWelcome(Command: WideString; Params: TStringList modActionsMain.actProjectNew.Execute else if Command = 'openproject' then modActionsMain.actProjectOpen.Execute + else if Command = 'openprojectfolder' then + modActionsMain.actProjectOpenFolder.Execute else if Command = 'editfile' then // MRU begin if SelectedMRUFileName <> '' then @@ -570,6 +573,11 @@ procedure TfrmProject.WebCommandProject(Command: WideString; Params: TStringList pf := SelectedProjectFile; if Assigned(pf) then (pf.UI as TProjectFileUI).DoAction(pfaCompile, False); end + else if Command = 'upgradeproject' then + begin + TryUpgradeProject(FGlobalProject); + ProjectRefresh(nil); + end else if Command = 'checkforupdates' then begin modActionsMain.actHelpCheckForUpdates.Execute; diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UpgradeProject.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UpgradeProject.pas new file mode 100644 index 00000000000..463f93ba764 --- /dev/null +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UpgradeProject.pas @@ -0,0 +1,60 @@ +unit Keyman.Developer.UI.Project.UpgradeProject; + +interface + +uses + Keyman.Developer.System.Project.ProjectFile; + +type + TUpgradeResult = (urNoAction, urUpgraded, urCancelled); + +function TryUpgradeProject(Project: TProject): TUpgradeResult; + +implementation + +uses + System.UITypes, + Vcl.Controls, + Vcl.Dialogs, + + KeymanDeveloperOptions; + +function TryUpgradeProject(Project: TProject): TUpgradeResult; +begin + Result := urNoAction; + + if Project.Options.Version = pv20 then + begin + // We are already up to date + Exit; + end; + +{ if not FKeymanDeveloperOptions.PromptForProjectUpgrade then + begin + // User wishes to stick with v1.0 projects + Exit; + end;} + + if not Project.CanUpgrade then + begin + // Project has restrictions, such as files in wrong folders, so + // we cannot upgrade. Show a message for the user + ShowMessage('The current project cannot be upgraded to v2.0. The following errors were encountered:'#13#10+ + Project.UpgradeMessages.Text); + Exit; + end; + + case MessageDlg('The current project can be upgraded to Keyman Developer 17.0 format. Do you wish to upgrade it (recommended)?', + mtConfirmation, mbYesNoCancel, 0) of + mrNo: Exit; + mrCancel: Exit(urCancelled); + end; + + // .. do the upgrade + + Project.Upgrade; + + Result := urUpgraded; +end; + +end. diff --git a/developer/src/tike/tike.dpr b/developer/src/tike/tike.dpr index bd2e6639331..7590379d0c9 100644 --- a/developer/src/tike/tike.dpr +++ b/developer/src/tike/tike.dpr @@ -281,7 +281,8 @@ uses Keyman.Developer.UI.UfrmEditLanguageExample in 'dialogs\examples\Keyman.Developer.UI.UfrmEditLanguageExample.pas' {frmEditLanguageExample}, Keyman.Developer.UI.UfrmEditRelatedPackage in 'dialogs\relatedPackages\Keyman.Developer.UI.UfrmEditRelatedPackage.pas' {frmEditRelatedPackage}, Keyman.Developer.UI.UfrmEditPackageWebFonts in 'dialogs\packageWebFonts\Keyman.Developer.UI.UfrmEditPackageWebFonts.pas' {frmEditPackageWebFonts}, - Keyman.Developer.System.KmcWrapper in 'compile\Keyman.Developer.System.KmcWrapper.pas'; + Keyman.Developer.System.KmcWrapper in 'compile\Keyman.Developer.System.KmcWrapper.pas', + Keyman.Developer.UI.Project.UpgradeProject in 'project\Keyman.Developer.UI.Project.UpgradeProject.pas'; {$R *.RES} {$R ICONS.RES} diff --git a/developer/src/tike/tike.dproj b/developer/src/tike/tike.dproj index 81d0469dca5..7f50777db96 100644 --- a/developer/src/tike/tike.dproj +++ b/developer/src/tike/tike.dproj @@ -559,6 +559,7 @@ dfm + Cfg_2 diff --git a/developer/src/tike/xml/project/distribution.xsl b/developer/src/tike/xml/project/distribution.xsl index 998065b8427..3d72f0626fb 100644 --- a/developer/src/tike/xml/project/distribution.xsl +++ b/developer/src/tike/xml/project/distribution.xsl @@ -44,15 +44,19 @@ + +
New file... keyman:fileaddnew?type=text - - Add existing file... - keyman:fileaddexisting?type=text - + + + Add existing file... + keyman:fileaddexisting?type=text + + | Build all diff --git a/developer/src/tike/xml/project/elements.xsl b/developer/src/tike/xml/project/elements.xsl index b624dcc055e..3102e3c1314 100644 --- a/developer/src/tike/xml/project/elements.xsl +++ b/developer/src/tike/xml/project/elements.xsl @@ -254,4 +254,19 @@ + + + + +
+

⚠️ This project file is in an old format. You should upgrade it to the Keyman Developer 17.0 project format. + + Upgrade project + keyman:upgradeproject + +

+
+ + + \ No newline at end of file diff --git a/developer/src/tike/xml/project/globalwelcome.xsl b/developer/src/tike/xml/project/globalwelcome.xsl index aecd70d90ff..6f956bd2336 100644 --- a/developer/src/tike/xml/project/globalwelcome.xsl +++ b/developer/src/tike/xml/project/globalwelcome.xsl @@ -57,6 +57,10 @@ Open Existing Project... keyman:openproject + + Open Existing Project Folder... + keyman:openprojectfolder +
diff --git a/developer/src/tike/xml/project/keyboards.xsl b/developer/src/tike/xml/project/keyboards.xsl index 9da09d7df3a..3287a159865 100644 --- a/developer/src/tike/xml/project/keyboards.xsl +++ b/developer/src/tike/xml/project/keyboards.xsl @@ -68,17 +68,21 @@ + +
New keyboard... keyman:fileaddnew?type=keyboard auto - - Add existing keyboard... - keyman:fileaddexisting?type=keyboard - auto - + + + Add existing keyboard... + keyman:fileaddexisting?type=keyboard + auto + + | Build all diff --git a/developer/src/tike/xml/project/models.xsl b/developer/src/tike/xml/project/models.xsl index a1a41286b99..a68cecc347d 100644 --- a/developer/src/tike/xml/project/models.xsl +++ b/developer/src/tike/xml/project/models.xsl @@ -56,17 +56,21 @@
+ +
New model... keyman:fileaddnew?type=model auto - - Add existing model... - keyman:fileaddexisting?type=model - auto - + + + Add existing model... + keyman:fileaddexisting?type=model + auto + + | Build all diff --git a/developer/src/tike/xml/project/packages.xsl b/developer/src/tike/xml/project/packages.xsl index ff5a8e520a6..2a5905b907f 100644 --- a/developer/src/tike/xml/project/packages.xsl +++ b/developer/src/tike/xml/project/packages.xsl @@ -49,15 +49,19 @@
+ +
New package... keyman:fileaddnew?type=package - - Add existing package... - keyman:fileaddexisting?type=package - + + + Add existing package... + keyman:fileaddexisting?type=package + + | Build all diff --git a/developer/src/tike/xml/project/project.css b/developer/src/tike/xml/project/project.css index 30163b71310..f47cbcf338c 100644 --- a/developer/src/tike/xml/project/project.css +++ b/developer/src/tike/xml/project/project.css @@ -11,6 +11,20 @@ overflow-y: auto; } +.upgrade-warning { + padding: 8px; + border: solid 1px #c0c000; + background: #ffefb0; + margin: 0 8px 16px 10px; + max-width: 800px; + border-radius: 4px; +} + +.upgrade-warning input { + float: right; + margin-top: -3px; +} + .tabbackground { position: absolute; bottom: 0px; diff --git a/developer/src/tike/xml/project/welcome.xsl b/developer/src/tike/xml/project/welcome.xsl index cc387561653..190ac80975d 100644 --- a/developer/src/tike/xml/project/welcome.xsl +++ b/developer/src/tike/xml/project/welcome.xsl @@ -46,6 +46,8 @@
+ +
Open project folder