mirror of
https://github.com/keymanapp/keyman.git
synced 2026-09-16 04:37:41 +00:00
496 lines
14 KiB
ObjectPascal
496 lines
14 KiB
ObjectPascal
unit Keyman.Developer.System.LexicalModelParser;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes,
|
|
System.RegularExpressions,
|
|
|
|
Keyman.Developer.System.LexicalModelParserTypes;
|
|
|
|
type
|
|
TLexicalModelParser = class
|
|
private
|
|
FText: TStrings;
|
|
FModified: Boolean;
|
|
FComment: string;
|
|
FFormat: TLexicalModelFormat;
|
|
FWordlists: TStrings;
|
|
FWordBreaker: TLexicalModelWordBreaker;
|
|
FIsEditable: Boolean;
|
|
FInsertAfterWord: string;
|
|
FIsRTL: Boolean;
|
|
FOpenQuote: string;
|
|
FCloseQuote: string;
|
|
FLanguageUsesCasing: Boolean;
|
|
function GetText: string;
|
|
procedure PrepareText;
|
|
procedure SetComment(const Value: string);
|
|
procedure SetFormat(const Value: TLexicalModelFormat);
|
|
procedure SetWordBreaker(const Value: TLexicalModelWordBreaker);
|
|
procedure Parse;
|
|
procedure Modify;
|
|
function ReplaceFormat(const m: TMatch): string;
|
|
function ReplaceWordBreaker(const m: TMatch): string;
|
|
function ReplaceSources(const m: TMatch): string;
|
|
function ReplaceComment(const m: TMatch): string;
|
|
procedure WordlistsChange(Sender: TObject);
|
|
function ReplaceInsertAfterWord(const punctuation: string): string;
|
|
function ReplaceIsRTL(const punctuation: string): string;
|
|
function ReplaceQuotesForKeepSuggestion(const punctuation: string): string;
|
|
procedure SetCloseQuote(const Value: string);
|
|
procedure SetInsertAfterWord(const Value: string);
|
|
procedure SetIsRTL(const Value: Boolean);
|
|
procedure SetOpenQuote(const Value: string);
|
|
|
|
function JSONEncodeString(const s: string): string;
|
|
function JSONDecodeString(s: string): string;
|
|
procedure SetLanguageUsesCasing(const Value: Boolean);
|
|
function ReplaceLanguageUsesCasing(const m: TMatch): string;
|
|
public
|
|
constructor Create(Source: string);
|
|
destructor Destroy; override;
|
|
property Text: string read GetText;
|
|
property Format: TLexicalModelFormat read FFormat write SetFormat;
|
|
property WordBreaker: TLexicalModelWordBreaker read FWordBreaker write SetWordBreaker;
|
|
property Wordlists: TStrings read FWordlists;
|
|
property Comment: string read FComment write SetComment;
|
|
property IsEditable: Boolean read FIsEditable;
|
|
property IsRTL: Boolean read FIsRTL write SetIsRTL;
|
|
property LanguageUsesCasing: Boolean read FLanguageUsesCasing write SetLanguageUsesCasing;
|
|
property OpenQuote: string read FOpenQuote write SetOpenQuote;
|
|
property CloseQuote: string read FCloseQuote write SetCloseQuote;
|
|
property InsertAfterWord: string read FInsertAfterWord write SetInsertAfterWord;
|
|
public
|
|
// These defaults are defined in common/lexical-model-types/index.d.ts
|
|
const
|
|
CDefaultInsertAfterWord = ' ';
|
|
CDefaultIsRTL = False;
|
|
CDefaultLanguageUsesCasing = False;
|
|
CDefaultOpenQuote = Char($201c);
|
|
CDefaultCloseQuote = Char($201d);
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.JSON,
|
|
System.SysUtils;
|
|
|
|
{ TLexicalModelParser }
|
|
|
|
const
|
|
SComment = '^\s*\/\*(.+?)\*\/';
|
|
SFormat = 'format\s*:\s*([''"])(.+?)(\1)';
|
|
SWordBreaker = 'wordBreaker\s*:\s*([''"])(.+?)(\1)';
|
|
SSources = 'sources\s*:\s*\[(.*?)\]';
|
|
SSource = '\s*([''"])(.+?)(\1)\s*(,?)';
|
|
|
|
SLanguageUsesCasingID = 'languageUsesCasing';
|
|
SLanguageUsesCasing = SLanguageUsesCasingID+'\s*:\s*(true|false)';
|
|
|
|
SEndOfObject = '\s*};';
|
|
SPunctuationID = 'punctuation';
|
|
SPunctuation =
|
|
',?\s*'+SPunctuationID+'\s*:\s*{\s*(('+
|
|
'(insertAfterWord\s*:\s*(([''"]).*?(\5)))|'+
|
|
'(isRTL\s*:\s*(true|false))|'+
|
|
'(quotesForKeepSuggestion\s*:\s*{\s*'+
|
|
'open\s*:\s*(([''"]).*?(\11))\s*,\s*'+
|
|
'close\s*:\s*(([''"]).*?(\14))\s*})'+
|
|
'),?\s*)*}';
|
|
|
|
// These may delete the entry so we need to take the `,` into account
|
|
SInsertAfterWordID = 'insertAfterWord';
|
|
SInsertAfterWord = ',?\s*'+SInsertAfterWordID+'\s*:\s*(([''"]).*?(\2))';
|
|
|
|
SIsRTLID = 'isRTL';
|
|
SIsRTL = ',?\s*'+SIsRTLID+'\s*:\s*(true|false)';
|
|
|
|
SQuotesForKeepSuggestionID = 'quotesForKeepSuggestion';
|
|
SQuotesForKeepSuggestion =
|
|
',?\s*'+SQuotesForKeepSuggestionID+'\s*:\s*{\s*'+
|
|
'open\s*:\s*(([''"]).*?(\2))\s*,\s*'+
|
|
'close\s*:\s*(([''"]).*?(\5))\s*'+
|
|
'}';
|
|
|
|
constructor TLexicalModelParser.Create(Source: string);
|
|
begin
|
|
inherited Create;
|
|
FWordlists := TStringList.Create;
|
|
(FWordlists as TStringList).OnChange := WordlistsChange;
|
|
FText := TStringList.Create;
|
|
FText.Text := Source;
|
|
Parse;
|
|
FModified := False;
|
|
end;
|
|
|
|
destructor TLexicalModelParser.Destroy;
|
|
begin
|
|
FreeAndNil(FWordlists);
|
|
FreeAndNil(FText);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLexicalModelParser.GetText: string;
|
|
begin
|
|
PrepareText;
|
|
Result := FText.Text;
|
|
end;
|
|
|
|
function TLexicalModelParser.JSONDecodeString(s: string): string;
|
|
var
|
|
v: TJSONValue;
|
|
begin
|
|
if s[1] = '''' then
|
|
begin
|
|
// Javascript can have ' but JSON only "
|
|
s[1] := '"';
|
|
s[Length(s)] := '"';
|
|
end;
|
|
v := TJSONObject.ParseJSONValue(s);
|
|
try
|
|
if not v.TryGetValue<string>(Result) then
|
|
Result := '';
|
|
finally
|
|
v.Free;
|
|
end;
|
|
end;
|
|
|
|
function TLexicalModelParser.JSONEncodeString(const s: string): string;
|
|
var
|
|
j: TJSONString;
|
|
begin
|
|
j := TJSONString.Create(s);
|
|
try
|
|
Result := j.ToJSON;
|
|
finally
|
|
j.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.Modify;
|
|
begin
|
|
FModified := True;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.Parse;
|
|
var
|
|
re: TRegEx;
|
|
m: TMatch;
|
|
s: string;
|
|
begin
|
|
// Long term, we should probably consider using the TypeScript compiler
|
|
// to real-time generate an AST and work from that. But that introduces a
|
|
// layer of glue to the Delphi code that I don't want to get into just now.
|
|
FIsEditable := True;
|
|
FFormat := lmfUnknown;
|
|
FWordBreaker := lmwbUnknown;
|
|
FComment := '';
|
|
|
|
FInsertAfterWord := CDefaultInsertAfterWord;
|
|
FIsRTL := CDefaultIsRTL;
|
|
FLanguageUsesCasing := CDefaultLanguageUsesCasing;
|
|
FOpenQuote := CDefaultOpenQuote;
|
|
FCloseQuote := CDefaultCloseQuote;
|
|
|
|
s := FText.Text;
|
|
|
|
// /* Comment */
|
|
m := TRegEx.Match(s, SComment, [roSingleLine]);
|
|
if m.Success then
|
|
FComment := m.Groups[1].Value;
|
|
|
|
// format:
|
|
m := TRegEx.Match(s, SFormat, [roMultiLine]);
|
|
if m.Success then
|
|
FFormat := TLexicalModelParserTypes.FormatFromText(m.Groups[2].Value);
|
|
|
|
// wordBreaker:
|
|
m := TRegEx.Match(s, SWordBreaker, [roMultiLine]);
|
|
if m.Success then
|
|
FWordBreaker := TLexicalModelParserTypes.WordBreakerFromText(m.Groups[2].Value);
|
|
|
|
// sources:
|
|
FWordlists.Clear;
|
|
m := TRegEx.Match(s, SSources, [roMultiLine]);
|
|
if m.Success then
|
|
begin
|
|
re := TRegEx.Create(SSource, [roMultiLine]);
|
|
m := re.Match(m.Groups[1].Value);
|
|
while m.Success do
|
|
begin
|
|
FWordlists.Add(m.Groups[2].Value);
|
|
m := m.NextMatch;
|
|
end;
|
|
end
|
|
else
|
|
FIsEditable := False;
|
|
|
|
// insertAfterWord:
|
|
m := TRegEx.Match(s, SInsertAfterWord, [roMultiLine]);
|
|
if m.Success then
|
|
FInsertAfterWord := JSONDecodeString(m.Groups[1].Value)
|
|
else if TRegEx.Match(s, SInsertAfterWordID, [roMultiLine]).Success then
|
|
FIsEditable := False;
|
|
|
|
|
|
// isRTL: true
|
|
m := TRegEx.Match(s, SIsRTL, [roMultiLine]);
|
|
if m.Success then
|
|
FIsRTL := m.Groups[1].Value = 'true'
|
|
else if TRegEx.Match(s, SIsRTLID, [roMultiLine]).Success then
|
|
FIsEditable := False;
|
|
|
|
// languageUsesCasing: true
|
|
m := TRegEx.Match(s, SLanguageUsesCasing, [roMultiLine]);
|
|
if m.Success then
|
|
FLanguageUsesCasing := m.Groups[1].Value = 'true'
|
|
else if TRegEx.Match(s, SLanguageUsesCasingID, [roMultiLine]).Success then
|
|
FIsEditable := False;
|
|
|
|
// quotesForKeepSuggestion: We assume that both open and close are defined,
|
|
// in that order.
|
|
m := TRegEx.Match(s, SQuotesForKeepSuggestion, [roMultiLine]);
|
|
if m.Success then
|
|
begin
|
|
FOpenQuote := JSONDecodeString(m.Groups[1].Value);
|
|
FCloseQuote := JSONDecodeString(m.Groups[4].Value);
|
|
end
|
|
else if TRegEx.Match(s, SQuotesForKeepSuggestionID, [roMultiLine]).Success then
|
|
FIsEditable := False;
|
|
|
|
if TRegEx.IsMatch(s, SPunctuationID) and not TRegEx.IsMatch(s, SPunctuation) then
|
|
FIsEditable := False;
|
|
|
|
|
|
FIsEditable := FIsEditable and
|
|
TRegEx.IsMatch(s, SEndOfObject) and
|
|
(FFormat <> lmfUnknown) and
|
|
(FWordBreaker <> lmwbUnknown);
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceComment(const m: TMatch): string;
|
|
begin
|
|
if FComment = ''
|
|
then Result := ''
|
|
else Result := '/*'+FComment+'*/';
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceFormat(const m: TMatch): string;
|
|
begin
|
|
Result := m.Value.Substring(0, m.Groups[2].Index - m.Index) +
|
|
TLexicalModelParserTypes.FormatToText(FFormat) +
|
|
m.Value.Substring(m.Groups[2].Index - m.Index + m.Groups[2].Length);
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceWordBreaker(const m: TMatch): string;
|
|
begin
|
|
Result := m.Value.Substring(0, m.Groups[2].Index - m.Index) +
|
|
TLexicalModelParserTypes.WordBreakerToText(FWordBreaker) +
|
|
m.Value.Substring(m.Groups[2].Index - m.Index + m.Groups[2].Length);
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceSources(const m: TMatch): string;
|
|
var
|
|
sources: string;
|
|
source: string;
|
|
begin
|
|
sources := '';
|
|
for source in FWordlists do
|
|
begin
|
|
if sources <> '' then
|
|
sources := sources + ', ';
|
|
sources := sources + '''' + source + ''''; // assuming no quote characters
|
|
end;
|
|
|
|
Result := m.Value.Substring(0, m.Groups[1].Index - m.Index) +
|
|
sources +
|
|
m.Value.Substring(m.Groups[1].Index - m.Index + m.Groups[1].Length);
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceLanguageUsesCasing(const m: TMatch): string;
|
|
begin
|
|
Result := m.Value.Substring(0, m.Groups[1].Index - m.Index);
|
|
if FLanguageUsesCasing
|
|
then Result := Result + 'true'
|
|
else Result := Result + 'false';
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceInsertAfterWord(const punctuation: string): string;
|
|
begin
|
|
if punctuation = ''
|
|
then Result := ''
|
|
else Result := punctuation + ','#13#10;
|
|
|
|
Result := Result +
|
|
' insertAfterWord: '+JSONEncodeString(FInsertAfterWord);
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceIsRTL(const punctuation: string): string;
|
|
begin
|
|
if punctuation = ''
|
|
then Result := ''
|
|
else Result := punctuation + ','#13#10;
|
|
|
|
Result := Result +
|
|
' isRTL: true';
|
|
end;
|
|
|
|
function TLexicalModelParser.ReplaceQuotesForKeepSuggestion(const punctuation: string): string;
|
|
begin
|
|
if punctuation = ''
|
|
then Result := ''
|
|
else Result := punctuation + ','#13#10;
|
|
|
|
Result := Result +
|
|
' quotesForKeepSuggestion: {'#13#10+
|
|
' open: '+JSONEncodeString(FOpenQuote)+','#13#10+
|
|
' close: '+JSONEncodeString(FCloseQuote)+#13#10+
|
|
' }';
|
|
end;
|
|
|
|
procedure TLexicalModelParser.PrepareText;
|
|
var
|
|
punctuation, s: string;
|
|
m: TMatch;
|
|
begin
|
|
if not FModified then Exit;
|
|
|
|
s := FText.Text;
|
|
|
|
// Replace tokens
|
|
s := TRegEx.Replace(s, SFormat, ReplaceFormat, [roMultiLine]);
|
|
s := TRegEx.Replace(s, SWordBreaker, ReplaceWordBreaker, [roMultiLine]);
|
|
s := TRegEx.Replace(s, SSources, ReplaceSources, [roMultiLine]);
|
|
|
|
if TRegEx.IsMatch(s, SLanguageUsesCasing, [roMultiLine]) then
|
|
s := TRegEx.Replace(s, SLanguageUsesCasing, ReplaceLanguageUsesCasing, [roMultiLine])
|
|
else if FLanguageUsesCasing then
|
|
begin
|
|
m := TRegEx.Match(s, SEndOfObject, [roMultiLine]);
|
|
if m.Success then
|
|
s := s.Substring(0, m.Index - 1) + ','#13#10' languageUsesCasing: true' + s.Substring(m.Index);
|
|
end;
|
|
|
|
s := TRegEx.Replace(s, SPunctuation, '', [roMultiLine]);
|
|
|
|
punctuation := '';
|
|
|
|
if FInsertAfterWord <> CDefaultInsertAfterWord then
|
|
punctuation := ReplaceInsertAfterWord(punctuation);
|
|
|
|
if FIsRTL <> CDefaultIsRTL then
|
|
punctuation := ReplaceIsRTL(punctuation);
|
|
|
|
if (FOpenQuote <> CDefaultOpenQuote) or (FCloseQuote <> CDefaultCloseQuote) then
|
|
punctuation := ReplaceQuotesForKeepSuggestion(punctuation);
|
|
|
|
if punctuation <> '' then
|
|
begin
|
|
punctuation :=
|
|
','#13#10+
|
|
' punctuation: {'+#13#10+
|
|
punctuation + #13#10+
|
|
' }';
|
|
m := TRegEx.Match(s, SEndOfObject, [roMultiLine]);
|
|
if m.Success then
|
|
s := s.Substring(0, m.Index - 1) + punctuation + s.Substring(m.Index);
|
|
end;
|
|
|
|
// Replace, remove or add comment
|
|
if TRegEx.IsMatch(s, SComment, [roSingleLine]) then
|
|
s := TRegEx.Replace(s, SComment, ReplaceComment, [roSingleLine])
|
|
else if FComment <> '' then
|
|
s := '/*'+FComment+'*/'#13#10+s;
|
|
|
|
|
|
FText.Text := s;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetCloseQuote(const Value: string);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FCloseQuote <> Value then
|
|
begin
|
|
FCloseQuote := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetComment(const Value: string);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FComment <> Value then
|
|
begin
|
|
FComment := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetFormat(const Value: TLexicalModelFormat);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FFormat <> Value then
|
|
begin
|
|
FFormat := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetInsertAfterWord(const Value: string);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FInsertAfterWord <> Value then
|
|
begin
|
|
FInsertAfterWord := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetIsRTL(const Value: Boolean);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FIsRTL <> Value then
|
|
begin
|
|
FIsRTL := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetLanguageUsesCasing(const Value: Boolean);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FLanguageUsesCasing <> Value then
|
|
begin
|
|
FLanguageUsesCasing := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetOpenQuote(const Value: string);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FOpenQuote <> Value then
|
|
begin
|
|
FOpenQuote := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.SetWordBreaker(const Value: TLexicalModelWordBreaker);
|
|
begin
|
|
Assert(FIsEditable);
|
|
if FWordBreaker <> Value then
|
|
begin
|
|
FWordBreaker := Value;
|
|
Modify;
|
|
end;
|
|
end;
|
|
|
|
procedure TLexicalModelParser.WordlistsChange(Sender: TObject);
|
|
begin
|
|
Modify;
|
|
end;
|
|
|
|
end.
|