Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

feat(developer): Support loading XML LDML keyboards in TIKE 🦕 #9963

Merged
merged 7 commits into from
Nov 15, 2023
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@ procedure TAppHttpResponder.RespondProject(doc: string; AContext: TIdContext;

path := CrackUTF8ZeroExtendedString(ARequestInfo.CommandType, ARequestInfo.Params.Values['path']);

if (Path <> '') and (not FileExists(path) or not SameText(ExtractFileExt(path), Ext_ProjectSource)) then
if (Path <> '') and (not DirectoryExists(ExtractFileDir(path)) or not SameText(ExtractFileExt(path), Ext_ProjectSource)) then
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ResponseText := 'Project file '+path+' does not exist.';
Expand Down Expand Up @@ -191,7 +191,7 @@ procedure TAppHttpResponder.RespondProject(doc: string; AContext: TIdContext;

// Saving state

if (Path <> '') and (not FileExists(path) or not SameText(ExtractFileExt(path), Ext_ProjectSource)) then
if (Path <> '') and (not DirectoryExists(ExtractFileDir(path)) or not SameText(ExtractFileExt(path), Ext_ProjectSource)) then
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ResponseText := 'Project file '+path+' does not exist.';
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -265,6 +265,9 @@ TProjectFile = class
constructor Create(AProject: TProject; AFileName: string; AParent: TProjectFile); virtual;
destructor Destroy; override;

function IsCompilable: Boolean; virtual;
class function IsFileTypeSupported(const Filename: string): Boolean; virtual;

procedure Load(node: IXMLNode); virtual; // I4698
procedure LoadState(node: IXMLNode); virtual; // I4698
procedure Save(node: IXMLNode); virtual; // I4698
Expand Down Expand Up @@ -571,6 +574,19 @@ function TProjectFile.GetOwnerProject: TProject;
end;
end;

function TProjectFile.IsCompilable: Boolean;
begin
Result := False;
end;

class function TProjectFile.IsFileTypeSupported(
const Filename: string): Boolean;
begin
// assumes that if we are registered for the file type extension, then we can
// handle the file. For example, .xml LDML keyboards
Result := True;
end;

procedure TProjectFile.Load(node: IXMLNode); // I4698
var
i: Integer;
Expand Down Expand Up @@ -969,7 +985,7 @@ procedure TProject.PopulateFolder(const path: string);
function IsLMDLKeyboardFile(filename: string): Boolean;
if EndsText('.xml', filename) then
begin
Result := Pos('ldmlKeyboard.dtd', ReadUtf8FileText(ff)) > 0;
Result := Pos('ldmlKeyboard3.dtd', ReadUtf8FileText(ff)) > 0;
end
else
Result := False;
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,8 @@ function CreateProjectFile(AProject: TProject; AFileName: string; AParent: TProj
ni := -1;
for i := 0 to FRegisteredFileTypes.Count - 1 do
if FRegisteredFileTypes[i].Extension = '*' then ni := i
else if FRegisteredFileTypes[i].Extension = Ext then
else if (FRegisteredFileTypes[i].Extension = Ext) and
FRegisteredFileTypes[i].ProjectFileClass.IsFileTypeSupported(AFileName) then
begin
Result := FRegisteredFileTypes[i].ProjectFileClass.Create(AProject, AFileName, AParent);

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ procedure TProjectSaver.Execute; // I4698
node, root: IXMLNode;
defopts: TProjectOptionsRecord;
begin
if FProject.IsDefaultProject(pv20) then
if FProject.IsDefaultProject(pv20) and (FFileName <> '') then
begin
if FileExists(FFileName) then
System.SysUtils.DeleteFile(FFileName);
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -84,6 +84,7 @@ TkmnProjectFile = class(TOpenableProjectFile)
property KVKFileName: string read FKVKFileName;
property IsDebug: Boolean read FDebug;
public
function IsCompilable: Boolean; override;
procedure Load(node: IXMLNode); override; // I4698
procedure Save(node: IXMLNode); override; // I4698
procedure LoadState(node: IXMLNode); override; // I4698
Expand Down Expand Up @@ -170,6 +171,11 @@ function TkmnProjectFile.GetTargetFilename: string;
Result := OwnerProject.GetTargetFilename(OutputFileName, FileName, FTempFileVersion);
end;

function TkmnProjectFile.IsCompilable: Boolean;
begin
Result := True;
end;

procedure TkmnProjectFile.GetFileParameters;
var
j: Integer;
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ TkpsProjectFile = class(TOpenableProjectFile)
function GetRelativeOrder: Integer; override;
procedure GetFileParameters; override;
public
function IsCompilable: Boolean; override;
procedure Load(node: IXMLNode); override; // I4698
procedure Save(node: IXMLNode); override; // I4698

Expand Down Expand Up @@ -160,6 +161,11 @@ function TkpsProjectFile.GetTargetInstallerFilename: string;
Result := OwnerProject.GetTargetFilename(ChangeFileExt(ExtractFileName(FMSIFileName),'') + '-' + ChangeFileExt(ExtractFileName(OutputFilename), '') + '.exe', Filename, FileVersion);
end;

function TkpsProjectFile.IsCompilable: Boolean;
begin
Result := True;
end;

procedure TkpsProjectFile.Load(node: IXMLNode); // I4698
begin
inherited Load(node);
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ TmodelTsProjectFile = class(TOpenableProjectFile)

property IsDebug: Boolean read FDebug;
public
function IsCompilable: Boolean; override;
procedure LoadState(node: IXMLNode); override; // I4698
procedure SaveState(node: IXMLNode); override; // I4698

Expand Down Expand Up @@ -106,6 +107,11 @@ function TmodelTsProjectFile.GetTargetFilename: string;
Result := OwnerProject.GetTargetFilename(OutputFileName, FileName, FTempFileVersion);
end;

function TmodelTsProjectFile.IsCompilable: Boolean;
begin
Result := True;
end;

procedure TmodelTsProjectFile.GetFileParameters;
begin
SetFileVersion('1.0'); // I4701
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,184 @@
{
* Keyman is copyright (C) SIL International. MIT License.
*
* xmlLdmlProjectFile: LDML keyboard files
}
unit Keyman.Developer.System.Project.xmlLdmlProjectFile;

interface

uses
System.SysUtils,
Xml.XMLIntf,

Keyman.Developer.System.Project.ProjectFile,
Keyman.Developer.System.Project.ProjectFiles,
Keyman.Developer.System.Project.ProjectFileType,
UKeymanTargets;

type
TxmlLdmlProjectFile = class;

TxmlLdmlProjectFile = class(TOpenableProjectFile)
private
FDebug: Boolean;
FHeader_Name: WideString;
FTargets: TKeymanTargets;
FKVKFileName: string;

function GetOutputFilename: string;
function GetTargetFilename: string;
function GetJSTargetFilename: string;
protected
function GetRelativeOrder: Integer; override;
procedure GetFileParameters; override;

property KVKFileName: string read FKVKFileName;
property IsDebug: Boolean read FDebug;
public
class function IsFileTypeSupported(const Filename: string): Boolean; override;
function IsCompilable: Boolean; override;
procedure Load(node: IXMLNode); override; // I4698
procedure Save(node: IXMLNode); override; // I4698
procedure LoadState(node: IXMLNode); override; // I4698
procedure SaveState(node: IXMLNode); override; // I4698
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

While I'm not quite following the inheritance and/or polymorphism patterns used here and in ProjectFile.pas (as noticed via commit 1), I can see a pretty strong correlation between the methods.

I'm mostly confused why these procedures are override here but virtual there; I don't see the inheritance path between the two, and personally would've expected them to be sibling derived classes of a common base. But those might be small nits and partly due to my inexperience with Delphi in particular.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The implementation in ProjectFile.pas is the base class, hence it is virtual. The other classes are the overrides and extend the base functionality.


property Debug: Boolean read FDebug write FDebug;

property OutputFilename: string read GetOutputFilename;
property TargetFilename: string read GetTargetFilename;
property JSTargetFilename: string read GetJSTargetFilename;
property Header_Name: WideString read FHeader_Name;
property Targets: TKeymanTargets read FTargets;
end;

implementation

uses
System.Classes,
System.Variants,
Winapi.Windows,

KeyboardParser,
kmxfileconsts,
KeyboardFonts,
Keyman.System.KeyboardUtils,
utilsystem;

{-------------------------------------------------------------------------------
- TxmlLdmlProjectFile -
-------------------------------------------------------------------------------}

function TxmlLdmlProjectFile.IsCompilable: Boolean;
begin
Result := True;
end;

class function TxmlLdmlProjectFile.IsFileTypeSupported(const Filename: string): Boolean;
var
ss: TStringStream;
begin
// Look for DTD in plain text as an adequate heuristic
ss := TStringStream.Create('', TEncoding.UTF8);
try
ss.LoadFromFile(Filename);
Result := ss.DataString.IndexOf('ldmlKeyboard3.dtd') > 0;
finally
ss.Free;
end;
end;

procedure TxmlLdmlProjectFile.Save(node: IXMLNode); // I4698
begin
inherited Save(node); // I4698
node := node.AddChild('Details');
if FHeader_Name <> '' then node.AddChild('Name').NodeValue := FHeader_Name;
end;

procedure TxmlLdmlProjectFile.SaveState(node: IXMLNode); // I4698
begin
inherited SaveState(node);
node.AddChild('Debug').NodeValue := FDebug;
end;

procedure TxmlLdmlProjectFile.Load(node: IXMLNode); // I4698
begin
inherited Load(node);

if node.ChildNodes.IndexOf('Details') < 0 then Exit;
node := node.ChildNodes['Details'];
if node.ChildNodes.IndexOf('Name') >= 0 then FHeader_Name := VarToWideStr(node.ChildValues['Name']);
end;

procedure TxmlLdmlProjectFile.LoadState(node: IXMLNode); // I4698
begin
inherited LoadState(node);
try
if node.ChildNodes.IndexOf('Debug') >= 0 then FDebug := node.ChildValues['Debug'];
except
FDebug := False;
end;
end;

function TxmlLdmlProjectFile.GetRelativeOrder: Integer;
begin
Result := 20;
end;

function TxmlLdmlProjectFile.GetTargetFilename: string;
var
FTempFileVersion: string;
begin
// https://github.com/keymanapp/keyman/issues/631
// This appears to be a Delphi compiler bug (RSP-20457)
// Workaround is to make a copy of the parameter locally
// which fixes the reference counting.
FTempFileVersion := FileVersion;
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this still around? Issue 631 was closed in 2018.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

RSP-20457 is still not fixed.

Result := OwnerProject.GetTargetFilename(OutputFileName, FileName, FTempFileVersion);
end;

procedure TxmlLdmlProjectFile.GetFileParameters;
var
j: Integer;
value: WideString;
FVersion: string; // I4701
begin
FHeader_Name := '';
FKVKFileName := '';
SetFileVersion('1.0'); // I4701
FTargets := AllKeymanTargets;

if not FileExists(FileName) then Exit;

// TODO: Load from XML?
end;

function TxmlLdmlProjectFile.GetJSTargetFilename: string;
begin
if FTargets = [] then
GetFileParameters;

// There is no JS target if no target is specified
if FTargets * KMWKeymanTargets = [] then
Exit('');

Result := OwnerProject.GetTargetFilename(TKeyboardUtils.GetKeymanWebCompiledFileName(FileName), FileName, FileVersion);
end;

function TxmlLdmlProjectFile.GetOutputFilename: string;
begin
if FTargets = [] then
GetFileParameters;

// If no target is specified, we'll fall back to .kmx
// so we always have at least one target filename
if (FTargets <> []) and (FTargets * KMXKeymanTargets = []) then
Exit('');
Result := ChangeFileExt(FileName, '.kmx');
end;


initialization
RegisterProjectFileType('.xml', TxmlLdmlProjectFile);
end.

Loading