Merge pull request #15694 from keymanapp/fix/developer/cherry-pick/15063-clone-overwrite

fix(developer): prevent new projects from overwriting existing projects 🍒 🏠
This commit is contained in:
Marc Durdin 2026-03-06 21:01:36 +07:00 • committed by GitHub
commit e56c2f511b
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
7 changed files with 37 additions and 113 deletions

View file

@ -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, ProjectID: 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, ProjectID: 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) + 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);
Exit(False);
end;
Result := True;
end;
end.

View file

@ -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;

View file

@ -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);

View file

@ -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;

View file

@ -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 }

View file

@ -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 }

View file

@ -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 }