From 6843509d245048c31a13c42fe87044f73a698142 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Wed, 4 Mar 2026 05:45:21 +0100 Subject: [PATCH 1/2] fix(developer): prevent new projects from overwriting existing projects The new project UI process detects if the target project folder already exists in a given path, and asks if the author wants to overwrite it. However, this has been inconsistently implemented -- in the clone keyboard case, the process would fail with a message "error KM0B004: Output path already exists, not overwriting". In other cases, no files would be removed, but existing files would be overwritten where there was a collision, resulting in a messy project folder. I have opted to prevent this situation in a consistent manner, requiring the author to remove the folder themselves in Windows Explorer, even though this is higher friction, because it pushes them into verifying that they actually want to delete the contents of the folder. I also took the opportunity to DRY out this verification process in the six different New Project dialogs. Fixes: #15063 --- .../Keyman.Developer.UI.Project.ProjectUI.pas | 24 +++++++++++++++++++ ...oject.UfrmCloneGitHubProjectParameters.pas | 20 ++-------------- ....UfrmCloneKeymanCloudProjectParameters.pas | 21 ++-------------- ...roject.UfrmCloneLocalProjectParameters.pas | 20 ++-------------- ...t.UfrmNewLDMLKeyboardProjectParameters.pas | 21 ++-------------- ....Project.UfrmNewModelProjectParameters.pas | 21 ++-------------- ...er.UI.Project.UfrmNewProjectParameters.pas | 23 +++--------------- 7 files changed, 37 insertions(+), 113 deletions(-) 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 4bd05c588c..d1eb8c20bb 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas @@ -29,12 +29,16 @@ function LoadGlobalProjectUI(pt: TProjectType; AFilename: string): TProjectUI; procedure FreeGlobalProjectUI; function IsGlobalProjectUIReady: Boolean; function CreateTempGlobalProjectUI(pt: TProjectType): TProjectUI; +function VerifyNewProjectPathWithUser(const BasePath, KeyboardID: string): Boolean; implementation uses System.Hash, System.SysUtils, + System.UITypes, + Vcl.Controls, + Vcl.Dialogs, Winapi.Windows, Keyman.Developer.System.KeymanDeveloperPaths, @@ -153,4 +157,24 @@ begin hLockFile := INVALID_HANDLE_VALUE; end; +function VerifyNewProjectPathWithUser(const BasePath, KeyboardID: string): Boolean; +var + ProjectFolder: string; +begin + if not DirectoryExists(BasePath) then + begin + if MessageDlg('The target folder '+BasePath+' does not exist. Create it now?', mtConfirmation, mbOkCancel, 0) = mrCancel then + Exit(False); + end; + + ProjectFolder := IncludeTrailingPathDelimiter(BasePath) + KeyboardID; + if DirectoryExists(ProjectFolder) then + begin + MessageDlg('The project folder '+ProjectFolder+' already exists. Please choose a different folder or delete it in File Explorer.', mtError, [mbOk], 0); + Exit(False); + end; + + Result := True; +end; + end. diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneGitHubProjectParameters.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneGitHubProjectParameters.pas index ad042fc872..3ccf96289f 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneGitHubProjectParameters.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneGitHubProjectParameters.pas @@ -97,6 +97,7 @@ uses Keyman.Developer.System.HelpTopics, Keyman.Developer.System.Project.Project, Keyman.Developer.System.Project.ProjectFile, + Keyman.Developer.UI.Project.ProjectUI, Keyman.System.KeyboardUtils, Keyman.System.LexicalModelUtils, UfrmMain; @@ -331,29 +332,12 @@ begin end; function TfrmCloneGitHubProjectParameters.Validate: Boolean; -var - ProjectFolder: string; begin if IsSourceProjectALexicalModelProject then Result := TLexicalModelUtils.IsValidLexicalModelID(Trim(editProjectID.Text), True) else Result := TKeyboardUtils.IsValidKeyboardID(Trim(editProjectID.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) + editProjectID.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; + Result := Result and VerifyNewProjectPathWithUser(editPath.Text, editProjectID.Text); end; procedure TfrmCloneGitHubProjectParameters.UpdateProjectFilename; diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneKeymanCloudProjectParameters.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneKeymanCloudProjectParameters.pas index 557fd24ec2..b0e491f0c6 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneKeymanCloudProjectParameters.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneKeymanCloudProjectParameters.pas @@ -94,6 +94,7 @@ uses Keyman.Developer.System.HelpTopics, Keyman.Developer.System.Project.Project, Keyman.Developer.System.Project.ProjectFile, + Keyman.Developer.UI.Project.ProjectUI, Keyman.System.KeyboardUtils, UfrmMain, Upload_Settings; @@ -283,27 +284,9 @@ begin end; function TfrmCloneKeymanCloudProjectParameters.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; + Result := Result and VerifyNewProjectPathWithUser(editPath.Text, editKeyboardID.Text); end; procedure TfrmCloneKeymanCloudProjectParameters.SetKeyboardID(const Value: string); diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneLocalProjectParameters.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneLocalProjectParameters.pas index cfc24801b3..d986cf56ac 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneLocalProjectParameters.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmCloneLocalProjectParameters.pas @@ -89,6 +89,7 @@ uses Keyman.Developer.System.HelpTopics, Keyman.Developer.System.Project.Project, Keyman.Developer.System.Project.ProjectFile, + Keyman.Developer.UI.Project.ProjectUI, Keyman.System.KeyboardUtils, Keyman.System.LexicalModelUtils, UfrmMain; @@ -248,29 +249,12 @@ begin end; function TfrmCloneLocalProjectParameters.Validate: Boolean; -var - ProjectFolder: string; begin if IsSourceProjectALexicalModelProject then Result := TLexicalModelUtils.IsValidLexicalModelID(Trim(editProjectID.Text), True) else Result := TKeyboardUtils.IsValidKeyboardID(Trim(editProjectID.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) + editProjectID.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; + Result := Result and VerifyNewProjectPathWithUser(editPath.Text, editProjectID.Text); end; procedure TfrmCloneLocalProjectParameters.UpdateProjectFilename; diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewLDMLKeyboardProjectParameters.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewLDMLKeyboardProjectParameters.pas index 3868b6281b..686e1fef19 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewLDMLKeyboardProjectParameters.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewLDMLKeyboardProjectParameters.pas @@ -111,6 +111,7 @@ uses Keyman.Developer.System.Project.ProjectFile, Keyman.Developer.System.LDMLKeyboardProjectTemplate, Keyman.Developer.System.ProjectTemplate, + Keyman.Developer.UI.Project.ProjectUI, Keyman.System.KeyboardUtils, UfrmMain; @@ -319,27 +320,9 @@ begin end; function TfrmNewLDMLKeyboardProjectParameters.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; + Result := Result and VerifyNewProjectPathWithUser(editPath.Text, editKeyboardID.Text); end; { Languages Grid } diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewModelProjectParameters.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewModelProjectParameters.pas index 6f94062480..14a4b4bc83 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewModelProjectParameters.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewModelProjectParameters.pas @@ -137,6 +137,7 @@ uses Keyman.Developer.System.Project.ProjectFile, Keyman.Developer.System.ModelProjectTemplate, Keyman.Developer.System.ProjectTemplate, + Keyman.Developer.UI.Project.ProjectUI, Keyman.Developer.UI.UfrmSelectBCP47Language, UfrmMain; @@ -458,27 +459,9 @@ begin 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; + Result := Result and VerifyNewProjectPathWithUser(editPath.Text, editModelID.Text); end; { Dynamically update other fields based on filled details } diff --git a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProjectParameters.pas b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProjectParameters.pas index bac2ffd9a9..b618a5df10 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProjectParameters.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.UfrmNewProjectParameters.pas @@ -126,6 +126,7 @@ uses Keyman.Developer.System.Project.ProjectFile, Keyman.Developer.System.KeyboardProjectTemplate, Keyman.Developer.System.ProjectTemplate, + Keyman.Developer.UI.Project.ProjectUI, Keyman.Developer.UI.UfrmSelectBCP47Language, Keyman.System.KeyboardUtils, UfrmMain; @@ -455,28 +456,10 @@ begin 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; + Result := Result and VerifyNewProjectPathWithUser(editPath.Text, editKeyboardID.Text); +end; { Languages Grid } From 2053b1729951da133a5a3f634db9f79c317af427 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Thu, 5 Mar 2026 15:19:01 +0100 Subject: [PATCH 2/2] chore(developer): address review comments Co-authored-by: Darcy Wong --- .../tike/project/Keyman.Developer.UI.Project.ProjectUI.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 d1eb8c20bb..866fb38ee6 100644 --- a/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas +++ b/developer/src/tike/project/Keyman.Developer.UI.Project.ProjectUI.pas @@ -29,7 +29,7 @@ function LoadGlobalProjectUI(pt: TProjectType; AFilename: string): TProjectUI; procedure FreeGlobalProjectUI; function IsGlobalProjectUIReady: Boolean; function CreateTempGlobalProjectUI(pt: TProjectType): TProjectUI; -function VerifyNewProjectPathWithUser(const BasePath, KeyboardID: string): Boolean; +function VerifyNewProjectPathWithUser(const BasePath, ProjectID: string): Boolean; implementation @@ -157,7 +157,7 @@ begin hLockFile := INVALID_HANDLE_VALUE; end; -function VerifyNewProjectPathWithUser(const BasePath, KeyboardID: string): Boolean; +function VerifyNewProjectPathWithUser(const BasePath, ProjectID: string): Boolean; var ProjectFolder: string; begin @@ -167,7 +167,7 @@ begin Exit(False); end; - ProjectFolder := IncludeTrailingPathDelimiter(BasePath) + KeyboardID; + ProjectFolder := IncludeTrailingPathDelimiter(BasePath) + ProjectID; if DirectoryExists(ProjectFolder) then begin MessageDlg('The project folder '+ProjectFolder+' already exists. Please choose a different folder or delete it in File Explorer.', mtError, [mbOk], 0);