diff --git a/windows/src/developer/TIKE/Tike.dpr b/windows/src/developer/TIKE/Tike.dpr
index 00875c100d..03dc9a224c 100644
--- a/windows/src/developer/TIKE/Tike.dpr
+++ b/windows/src/developer/TIKE/Tike.dpr
@@ -283,12 +283,17 @@ uses
Keyman.Developer.System.ProjectTemplate in '..\kmconvert\Keyman.Developer.System.ProjectTemplate.pas',
Keyman.Developer.UI.Project.UfrmNewModelProjectParameters in 'project\Keyman.Developer.UI.Project.UfrmNewModelProjectParameters.pas' {frmNewModelProjectParameters},
Keyman.Developer.System.Project.wordlistTsvProjectFile in 'project\Keyman.Developer.System.Project.wordlistTsvProjectFile.pas',
- Keyman.Developer.UI.UfrmWordlistEditor in 'child\Keyman.Developer.UI.UfrmWordlistEditor.pas' {frmWordlistEditor},
+ Keyman.Developer.UI.UframeWordlistEditor in 'child\Keyman.Developer.UI.UframeWordlistEditor.pas' {frameWordlistEditor},
Keyman.System.WordlistTsvFile in '..\..\global\delphi\lexicalmodels\Keyman.System.WordlistTsvFile.pas',
Keyman.Developer.UI.Project.wordlistTsvProjectFileUI in 'project\Keyman.Developer.UI.Project.wordlistTsvProjectFileUI.pas',
Keyman.Developer.System.Project.WelcomeRenderer in 'project\Keyman.Developer.System.Project.WelcomeRenderer.pas',
DelphiZXIngQRCode in '..\..\ext\zxingqrcode\Source\DelphiZXIngQRCode.pas',
- Keyman.System.QRCode in '..\..\global\delphi\general\Keyman.System.QRCode.pas';
+ Keyman.System.QRCode in '..\..\global\delphi\general\Keyman.System.QRCode.pas',
+ Keyman.Developer.UI.UfrmModelEditor in 'child\Keyman.Developer.UI.UfrmModelEditor.pas' {frmModelEditor},
+ Keyman.Developer.System.LexicalModelParser in 'main\Keyman.Developer.System.LexicalModelParser.pas',
+ Keyman.Developer.System.LexicalModelParserTypes in 'main\Keyman.Developer.System.LexicalModelParserTypes.pas',
+ Keyman.Developer.UI.UfrmWordlistEditor in 'child\Keyman.Developer.UI.UfrmWordlistEditor.pas' {frmWordlistEditor},
+ Keyman.Developer.UI.dmActionsModelEditor in 'actions\Keyman.Developer.UI.dmActionsModelEditor.pas' {modActionsModelEditor: TDataModule};
{$R *.RES}
{$R ICONS.RES}
@@ -316,8 +321,8 @@ begin
if TikeActive then Exit;
InitClasses;
Application.CreateForm(TmodWebHttpServer, modWebHttpServer);
- Application.CreateForm(TfrmKeymanDeveloper, frmKeymanDeveloper);
- Application.Run;
+ Application.CreateForm(TfrmKeymanDeveloper, frmKeymanDeveloper);
+ Application.Run;
end;
finally
FInitializeCEF.Free;
diff --git a/windows/src/developer/TIKE/Tike.dproj b/windows/src/developer/TIKE/Tike.dproj
index d0e62e7198..77b8f26bd7 100644
--- a/windows/src/developer/TIKE/Tike.dproj
+++ b/windows/src/developer/TIKE/Tike.dproj
@@ -529,8 +529,8 @@
dfm
-
-
+
+
dfm
@@ -538,6 +538,21 @@
+
+
+ dfm
+
+
+
+
+
+ dfm
+
+
+
+ dfm
+ TDataModule
+
Cfg_2
diff --git a/windows/src/developer/TIKE/actions/Keyman.Developer.UI.dmActionsModelEditor.dfm b/windows/src/developer/TIKE/actions/Keyman.Developer.UI.dmActionsModelEditor.dfm
new file mode 100644
index 0000000000..086f56fe7c
--- /dev/null
+++ b/windows/src/developer/TIKE/actions/Keyman.Developer.UI.dmActionsModelEditor.dfm
@@ -0,0 +1,29 @@
+object modActionsModelEditor: TmodActionsModelEditor
+ OldCreateOrder = False
+ Height = 150
+ Width = 215
+ object actionsModelEditor: TActionList
+ Images = frmKeymanDeveloper.lstImages
+ Left = 60
+ Top = 24
+ object actModelCompile: TAction
+ Category = 'Lexical Model'
+ Caption = '&Compile Model'
+ ImageIndex = 37
+ ShortCut = 118
+ OnExecute = actModelCompileExecute
+ OnUpdate = actModelCompileUpdate
+ end
+ object actModelIncludeDebugInformation: TAction
+ Category = 'Lexical Model'
+ Caption = 'Include &Debug Information'
+ OnExecute = actModelIncludeDebugInformationExecute
+ end
+ object actModelTest: TAction
+ Category = 'Lexical Model'
+ Caption = 'Test &Lexical Model'
+ OnExecute = actModelTestExecute
+ OnUpdate = actModelTestUpdate
+ end
+ end
+end
diff --git a/windows/src/developer/TIKE/actions/Keyman.Developer.UI.dmActionsModelEditor.pas b/windows/src/developer/TIKE/actions/Keyman.Developer.UI.dmActionsModelEditor.pas
new file mode 100644
index 0000000000..594e25cde3
--- /dev/null
+++ b/windows/src/developer/TIKE/actions/Keyman.Developer.UI.dmActionsModelEditor.pas
@@ -0,0 +1,86 @@
+unit Keyman.Developer.UI.dmActionsModelEditor;
+
+interface
+
+uses
+ System.SysUtils, System.Classes, System.Actions, Vcl.ActnList;
+
+type
+ TmodActionsModelEditor = class(TDataModule)
+ actionsModelEditor: TActionList;
+ actModelCompile: TAction;
+ actModelTest: TAction;
+ actModelIncludeDebugInformation: TAction;
+ procedure actModelCompileExecute(Sender: TObject);
+ procedure actModelIncludeDebugInformationExecute(Sender: TObject);
+ procedure actModelTestExecute(Sender: TObject);
+ procedure actModelCompileUpdate(Sender: TObject);
+ procedure actModelTestUpdate(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ modActionsModelEditor: TmodActionsModelEditor;
+
+implementation
+
+{%CLASSGROUP 'Vcl.Controls.TControl'}
+
+uses
+ UfrmMain,
+ UfrmMessages,
+ Keyman.Developer.System.Project.ProjectFile,
+ Keyman.Developer.UI.Project.ProjectFileUI,
+ Keyman.Developer.System.Project.modelTsProjectFile,
+ Keyman.Developer.UI.UfrmModelEditor;
+
+{$R *.dfm}
+
+function ActiveModelEditor: TfrmModelEditor;
+begin
+ if Assigned(frmKeymanDeveloper.ActiveChild) and (frmKeymanDeveloper.ActiveChild is TfrmModelEditor)
+ then Result := frmKeymanDeveloper.ActiveChild as TfrmModelEditor
+ else Result := nil;
+end;
+
+function ActiveModelProjectFile: TmodelTsProjectFile;
+begin
+ Result := ActiveModelEditor.ProjectFile as TmodelTsProjectFile;
+end;
+
+procedure TmodActionsModelEditor.actModelCompileExecute(Sender: TObject);
+begin
+ frmMessages.Clear; // I4686
+
+ if ActiveModelEditor <> nil then
+ begin
+ (ActiveModelProjectFile.UI as TProjectFileUI).DoAction(pfaCompile, False);
+ end;
+end;
+
+procedure TmodActionsModelEditor.actModelCompileUpdate(Sender: TObject);
+begin
+ actModelCompile.Enabled := ActiveModelEditor <> nil;
+ frmKeymanDeveloper.mnuModel.Visible := actModelCompile.Enabled;
+end;
+
+procedure TmodActionsModelEditor.actModelIncludeDebugInformationExecute(
+ Sender: TObject);
+begin
+// TODO: (ActiveModelProjectFile.UI as TmodeltsProjectFileUI).Debug := not (ActiveModelProjectFile.UI as TmodeltsProjectFileUI).Debug; // I4687
+end;
+
+procedure TmodActionsModelEditor.actModelTestExecute(Sender: TObject);
+begin
+ (ActiveModelProjectFile.UI as TProjectFileUI).DoAction(pfaTestKeymanWeb, False); // I4687
+end;
+
+procedure TmodActionsModelEditor.actModelTestUpdate(Sender: TObject);
+begin
+ actModelTest.Enabled := ActiveModelEditor <> nil;
+end;
+
+end.
diff --git a/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.dfm b/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.dfm
index 15096c36e3..9cb7da5f24 100644
--- a/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.dfm
+++ b/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.dfm
@@ -23,7 +23,7 @@ object modActionsKeyboardEditor: TmodActionsKeyboardEditor
end
object actKeyboardCreatePackage: TAction
Category = 'Keyboard'
- Caption = '&Package for Distribution...'
+ Caption = 'Package for Distribution...'
ImageIndex = 40
OnExecute = actKeyboardCreatePackageExecute
end
diff --git a/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.pas b/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.pas
index a5a8c32d68..c7f7fdbf1b 100644
--- a/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.pas
+++ b/windows/src/developer/TIKE/actions/dmActionsKeyboardEditor.pas
@@ -446,7 +446,10 @@ end;
procedure TmodActionsKeyboardEditor.actKeyboardCompileUpdate(Sender: TObject);
begin
+ // TODO: Split Keyboard menu and package editor functions
actKeyboardCompile.Enabled := (ActiveEditor <> nil) or (ActivePackageEditor <> nil);
+ frmKeymanDeveloper.mnuKeyboard.Visible := actKeyboardCompile.Enabled;
+ frmKeymanDeveloper.mnuDebug.Visible := ActiveEditor <> nil;
end;
procedure TmodActionsKeyboardEditor.actKeyboardCreatePackageExecute(Sender: TObject);
diff --git a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UframeWordlistEditor.dfm b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UframeWordlistEditor.dfm
new file mode 100644
index 0000000000..7cea795c20
--- /dev/null
+++ b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UframeWordlistEditor.dfm
@@ -0,0 +1,87 @@
+inherited frameWordlistEditor: TframeWordlistEditor
+ BorderIcons = []
+ BorderStyle = bsNone
+ Caption = 'frameWordlistEditor'
+ ClientHeight = 338
+ ClientWidth = 651
+ OnResize = FormResize
+ ExplicitWidth = 651
+ ExplicitHeight = 338
+ PixelsPerInch = 96
+ TextHeight = 13
+ object pages: TPageControl
+ Left = 0
+ Top = 0
+ Width = 651
+ Height = 338
+ ActivePage = pageDesign
+ Align = alClient
+ TabOrder = 0
+ TabPosition = tpBottom
+ OnChanging = pagesChanging
+ ExplicitWidth = 635
+ ExplicitHeight = 299
+ object pageDesign: TTabSheet
+ Caption = 'Design'
+ ImageIndex = -1
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 627
+ ExplicitHeight = 273
+ object gridWordlist: TStringGridEditControlled
+ Left = 0
+ Top = 0
+ Width = 643
+ Height = 271
+ Align = alClient
+ ColCount = 3
+ DefaultRowHeight = 16
+ DefaultDrawing = False
+ FixedCols = 0
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goEditing, goTabs, goAlwaysShowEditor]
+ TabOrder = 0
+ OnClick = gridWordlistClick
+ OnDrawCell = gridWordlistDrawCell
+ OnSetEditText = gridWordlistSetEditText
+ ExplicitWidth = 627
+ ExplicitHeight = 232
+ end
+ object panGridControls: TPanel
+ Left = 0
+ Top = 271
+ Width = 643
+ Height = 41
+ Align = alBottom
+ TabOrder = 1
+ ExplicitTop = 232
+ ExplicitWidth = 627
+ object cmdDeleteRow: TButton
+ Left = 0
+ Top = 6
+ Width = 75
+ Height = 25
+ Caption = '&Delete row'
+ TabOrder = 0
+ OnClick = cmdDeleteRowClick
+ end
+ object cmdSortByFrequency: TButton
+ Left = 81
+ Top = 6
+ Width = 104
+ Height = 25
+ Caption = '&Sort by frequency'
+ TabOrder = 1
+ OnClick = cmdSortByFrequencyClick
+ end
+ end
+ end
+ object pageCode: TTabSheet
+ Caption = 'Code'
+ ImageIndex = -1
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
+ end
+ end
+end
diff --git a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UframeWordlistEditor.pas b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UframeWordlistEditor.pas
new file mode 100644
index 0000000000..c8739c0e59
--- /dev/null
+++ b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UframeWordlistEditor.pas
@@ -0,0 +1,340 @@
+unit Keyman.Developer.UI.UframeWordlistEditor;
+
+interface
+
+uses
+ System.Classes,
+ System.SysUtils,
+ System.Variants,
+ Winapi.Messages,
+ Winapi.Windows,
+ Vcl.ComCtrls,
+ Vcl.Controls,
+ Vcl.Dialogs,
+ Vcl.Forms,
+ Vcl.Graphics,
+ Vcl.Grids,
+
+ StringGridEditControlled,
+
+ Keyman.System.WordlistTsvFile,
+ UframeTextEditor,
+ UfrmMDIEditor, Vcl.StdCtrls, Vcl.ExtCtrls, UfrmTike;
+
+type
+ TframeWordlistEditor = class(TTIKEForm)
+ pages: TPageControl;
+ pageDesign: TTabSheet;
+ pageCode: TTabSheet;
+ gridWordlist: TStringGridEditControlled;
+ panGridControls: TPanel;
+ cmdDeleteRow: TButton;
+ cmdSortByFrequency: TButton;
+ procedure pagesChanging(Sender: TObject; var AllowChange: Boolean);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure gridWordlistSetEditText(Sender: TObject; ACol, ARow: Integer;
+ const Value: string);
+ procedure gridWordlistDrawCell(Sender: TObject; ACol, ARow: Integer;
+ ARect: TRect; State: TGridDrawState);
+ procedure cmdDeleteRowClick(Sender: TObject);
+ procedure gridWordlistClick(Sender: TObject);
+ procedure cmdSortByFrequencyClick(Sender: TObject);
+ private
+ FWordlist: TWordlistTsvFile;
+ frameSource: TframeTextEditor;
+ FSetup: Integer;
+ FModified: Boolean;
+ FOnModifiedChanged: TNotifyEvent;
+ FFilename: string;
+ procedure UpdateData;
+ function MoveCodeToWordlist: Boolean;
+ procedure FillCode;
+ procedure FillGrid;
+ function MoveDesignToWordlist: Boolean;
+ procedure SourceChanged(Sender: TObject);
+ procedure FillGridNewRow;
+ procedure EnableControls;
+ procedure SetModified(const Value: Boolean);
+ protected
+ function GetHelpTopic: string; override;
+ function DoOpenFile: Boolean;
+ function DoSaveFile: Boolean;
+ public
+ procedure FindError(const Filename: string; s: string; line: Integer); // I4081
+ function LoadFromFile(const Filename: string): Boolean;
+ function SaveToFile(const Filename: string): Boolean;
+ property Filename: string read FFilename;
+ property Modified: Boolean read FModified write SetModified;
+ property OnModifiedChanged: TNotifyEvent read FOnModifiedChanged write FOnModifiedChanged;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ Keyman.Developer.System.HelpTopics,
+ TextFileFormat,
+ UfrmMain,
+ UfrmMessages;
+
+const
+ ColWidth_Word = 120;
+ ColWidth_Frequency = 64;
+ S_AddRowText = 'Add word...';
+
+{ TfrmWordlistEditor }
+
+procedure TframeWordlistEditor.FormCreate(Sender: TObject);
+begin
+ inherited;
+ Inc(FSetup);
+ try
+ FWordlist := TWordlistTsvFile.Create;
+ frameSource := TframeTextEditor.Create(Self);
+ frameSource.Parent := pageCode;
+ frameSource.Align := alClient;
+ frameSource.EditorFormat := efWordlistTsv;
+ frameSource.Visible := True;
+ frameSource.OnChanged := SourceChanged;
+ frameSource.TextFileFormat := tffUTF8;
+//TODO: frameSource.UseTabs := True;
+ pages.ActivePage := pageDesign;
+
+ gridWordlist.Cells[0, 0] := 'Word Form';
+ gridWordlist.Cells[1, 0] := 'Count';
+ gridWordlist.Cells[2, 0] := 'Comment';
+ gridWordlist.ColWidths[0] := ColWidth_Word;
+ gridWordlist.ColWidths[1] := ColWidth_Frequency;
+ gridWordlist.ColWidths[2] := gridWordlist.ClientWidth - ColWidth_Word - ColWidth_Frequency - 2;
+ finally
+ Dec(FSetup);
+ end;
+end;
+
+procedure TframeWordlistEditor.FormDestroy(Sender: TObject);
+begin
+ inherited;
+ FWordlist.Free;
+end;
+
+procedure TframeWordlistEditor.FormResize(Sender: TObject);
+begin
+ inherited;
+ gridWordlist.ColWidths[2] := gridWordlist.ClientWidth - ColWidth_Word - ColWidth_Frequency - 2;
+end;
+
+procedure TframeWordlistEditor.cmdDeleteRowClick(Sender: TObject);
+begin
+ FWordlist.RemoveWord(gridWordlist.Row-1);
+ FillGrid;
+ EnableControls;
+ Modified := True;
+end;
+
+procedure TframeWordlistEditor.cmdSortByFrequencyClick(Sender: TObject);
+begin
+ FWordlist.SortByFrequency;
+ FillGrid;
+ Modified := True;
+end;
+
+function TframeWordlistEditor.DoOpenFile: Boolean;
+begin
+ if FileExists(FileName) then
+ begin
+ FWordlist.LoadFromFile(FileName);
+ end;
+ UpdateData;
+ Result := True;
+end;
+
+function TframeWordlistEditor.DoSaveFile: Boolean;
+begin
+ MoveCodeToWordlist; // Does nothing if not in code page
+ FWordlist.SaveToFile(FileName);
+ Result := True;
+end;
+
+procedure TframeWordlistEditor.EnableControls;
+var
+ e: Boolean;
+begin
+ e := gridWordlist.Row < gridWordlist.RowCount - 1;
+ cmdDeleteRow.Enabled := e;
+ cmdSortByFrequency.Enabled := e;
+end;
+
+procedure TframeWordlistEditor.FindError(const Filename: string; s: string; line: Integer);
+begin
+ //
+end;
+
+function TframeWordlistEditor.GetHelpTopic: string;
+begin
+ Result := SHelpTopic_Context_WordlistEditor;
+end;
+
+procedure TframeWordlistEditor.gridWordlistClick(Sender: TObject);
+begin
+ EnableControls;
+end;
+
+procedure TframeWordlistEditor.gridWordlistDrawCell(Sender: TObject; ACol,
+ ARow: Integer; ARect: TRect; State: TGridDrawState);
+var
+ LText: string;
+begin
+ inherited;
+ if ARow = gridWordlist.RowCount - 1 then
+ begin
+ // Drawing last row
+ gridWordlist.Canvas.Font.Style := [fsItalic];
+ end
+ else if gridWordlist.Cells[0, ARow] = '#' then
+ begin
+ // Drawing a comment cell
+ gridWordlist.Canvas.Font.Style := [fsBold];
+ end
+ else
+ gridWordlist.Canvas.Font.Style := [];
+
+ LText := gridWordlist.Cells[ACol, ARow];
+ gridWordlist.Canvas.TextRect(ARect, ARect.Left+2,
+ ARect.Top+((ARect.Height - gridWordlist.Canvas.TextHeight(LText)) div 2), LText);
+end;
+
+procedure TframeWordlistEditor.gridWordlistSetEditText(Sender: TObject; ACol,
+ ARow: Integer; const Value: string);
+var
+ w: TWordlistWord;
+begin
+ if FSetup > 0 then Exit;
+ Inc(FSetup);
+ try
+ Modified := True;
+
+ if ARow = gridWordlist.RowCount - 1 then
+ begin
+ if (Value = '') or (Value = S_AddRowText) then
+ Exit;
+
+ w.Word := Value;
+ w.Frequency := 0;
+ w.Comment := '';
+ FWordlist.AddWord(w);
+ gridWordlist.RowCount := gridWordlist.RowCount + 1;
+ FillGridNewRow;
+ end
+ else
+ begin
+ w := FWordlist.Word[ARow-1];
+ case ACol of
+ 0: w.Word := Value;
+ 1: w.Frequency := StrToIntDef(Value, 0);
+ 2: w.Comment := Value;
+ end;
+ FWordlist.Word[ARow-1] := w;
+ end;
+ finally
+ Dec(FSetup);
+ end;
+end;
+
+procedure TframeWordlistEditor.pagesChanging(Sender: TObject;
+ var AllowChange: Boolean);
+begin
+ if FSetup > 0 then Exit;
+
+ if pages.ActivePage = pageCode then
+ AllowChange := MoveCodeToWordlist
+ else
+ AllowChange := MoveDesignToWordlist
+end;
+
+function TframeWordlistEditor.MoveCodeToWordlist: Boolean;
+begin
+ if pages.ActivePage <> pageCode then
+ Exit(False);
+
+ FWordlist.Text := frameSource.EditorText;
+ FillGrid;
+ Result := True;
+end;
+
+function TframeWordlistEditor.MoveDesignToWordlist: Boolean;
+begin
+ FillCode;
+ Result := True;
+end;
+
+function TframeWordlistEditor.LoadFromFile(const Filename: string): Boolean;
+begin
+ FFilename := Filename;
+ Result := DoOpenFile;
+end;
+
+procedure TframeWordlistEditor.UpdateData;
+begin
+ if pages.ActivePage = pageCode
+ then FillCode
+ else FillGrid;
+end;
+
+function TframeWordlistEditor.SaveToFile(const Filename: string): Boolean;
+begin
+ FFilename := Filename;
+ Result := DoSaveFile;
+end;
+
+procedure TframeWordlistEditor.SetModified(const Value: Boolean);
+begin
+ if FModified <> Value then
+ begin
+ FModified := Value;
+ if Assigned(FOnModifiedChanged) then
+ FOnModifiedChanged(Self);
+ end;
+end;
+
+procedure TframeWordlistEditor.SourceChanged(Sender: TObject);
+begin
+ if FSetup = 0 then
+ Modified := True;
+end;
+
+procedure TframeWordlistEditor.FillCode;
+begin
+ frameSource.EditorText := FWordlist.Text;
+end;
+
+procedure TframeWordlistEditor.FillGrid;
+var
+ i: Integer;
+ w: TWordlistWord;
+begin
+ gridWordlist.RowCount := FWordlist.Count + 2;
+ for i := 0 to FWordlist.Count - 1 do
+ begin
+ w := FWordlist.Word[i];
+ gridWordlist.Cells[0, i+1] := w.Word;
+ if w.Frequency = 0
+ then gridWordlist.Cells[1, i+1] := ''
+ else gridWordlist.Cells[1, i+1] := IntToStr(w.Frequency);
+ gridWordlist.Cells[2, i+1] := w.Comment;
+ end;
+ FillGridNewRow;
+ gridWordlist.FixedRows := 1;
+end;
+
+procedure TframeWordlistEditor.FillGridNewRow;
+begin
+ gridWordlist.Cells[0, gridWordlist.RowCount - 1] := S_AddRowText;
+ gridWordlist.Cells[1, gridWordlist.RowCount - 1] := '';
+ gridWordlist.Cells[2, gridWordlist.RowCount - 1] := '';
+ EnableControls;
+end;
+
+end.
diff --git a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmModelEditor.dfm b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmModelEditor.dfm
new file mode 100644
index 0000000000..a9fbaca059
--- /dev/null
+++ b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmModelEditor.dfm
@@ -0,0 +1,410 @@
+inherited frmModelEditor: TfrmModelEditor
+ Left = 0
+ Top = 0
+ Caption = 'frmModelEditor'
+ ClientHeight = 708
+ ClientWidth = 712
+ Font.Name = 'Tahoma'
+ ExplicitWidth = 712
+ ExplicitHeight = 708
+ PixelsPerInch = 96
+ TextHeight = 13
+ object pages: TLeftTabbedPageControl
+ Left = 0
+ Top = 0
+ Width = 712
+ Height = 708
+ ActivePage = pageCompile
+ Align = alClient
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Segoe UI'
+ Font.Style = []
+ Images = modActionsMain.ilEditorPages
+ MultiLine = True
+ OwnerDraw = True
+ ParentFont = False
+ TabHeight = 90
+ TabOrder = 0
+ TabPosition = tpLeft
+ TabWidth = 60
+ OnChanging = pagesChanging
+ object pageDetails: TTabSheet
+ Caption = 'Details'
+ ImageIndex = 2
+ object sbDetails: TScrollBox
+ Left = 0
+ Top = 0
+ Width = 619
+ Height = 708
+ Align = alClient
+ BevelInner = bvNone
+ BevelOuter = bvNone
+ BorderStyle = bsNone
+ Color = 14211288
+ ParentColor = False
+ TabOrder = 0
+ object panWordlists: TPanel
+ AlignWithMargins = True
+ Left = 4
+ Top = 181
+ Width = 611
+ Height = 232
+ Margins.Left = 4
+ Margins.Top = 4
+ Margins.Right = 4
+ Margins.Bottom = 4
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 1
+ DesignSize = (
+ 611
+ 232)
+ object lblWordlists: TLabel
+ AlignWithMargins = True
+ Left = 12
+ Top = 4
+ Width = 64
+ Height = 17
+ Caption = 'Wordlists'
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -14
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object lblReadOnly: TLabel
+ Left = 15
+ Top = 200
+ Width = 415
+ Height = 13
+ Caption =
+ 'The editor was unable to parse the source file. Details shown he' +
+ 're are read-only.'
+ end
+ object gridWordlists: TStringGrid
+ Left = 12
+ Top = 27
+ Width = 485
+ Height = 160
+ Anchors = [akLeft, akTop, akRight]
+ ColCount = 1
+ FixedCols = 0
+ FixedRows = 0
+ Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect]
+ TabOrder = 0
+ OnDblClick = gridWordlistsDblClick
+ ColWidths = (
+ 271)
+ RowHeights = (
+ 24
+ 24
+ 24
+ 24
+ 24)
+ end
+ object cmdAddWordlist: TButton
+ Left = 503
+ Top = 27
+ Width = 101
+ Height = 25
+ Anchors = [akTop, akRight]
+ Caption = '&Add...'
+ TabOrder = 1
+ OnClick = cmdAddWordlistClick
+ end
+ object cmdRemoveWordlist: TButton
+ Left = 503
+ Top = 58
+ Width = 100
+ Height = 25
+ Anchors = [akTop, akRight]
+ Caption = 'Remove'
+ TabOrder = 2
+ OnClick = cmdRemoveWordlistClick
+ end
+ end
+ object panBasicInformation: TPanel
+ AlignWithMargins = True
+ Left = 4
+ Top = 6
+ Width = 611
+ Height = 167
+ Margins.Left = 4
+ Margins.Top = 6
+ Margins.Right = 4
+ Margins.Bottom = 4
+ Align = alTop
+ AutoSize = True
+ BevelOuter = bvNone
+ ParentColor = True
+ TabOrder = 0
+ DesignSize = (
+ 611
+ 167)
+ object lblFormat: TLabel
+ Left = 12
+ Top = 30
+ Width = 36
+ Height = 13
+ Caption = '&Format'
+ end
+ object lblBasicInformation: TLabel
+ AlignWithMargins = True
+ Left = 12
+ Top = 3
+ Width = 123
+ Height = 17
+ Caption = 'Basic Information'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -14
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object lblWordBreaker: TLabel
+ Left = 12
+ Top = 56
+ Width = 71
+ Height = 13
+ Caption = '&Word breaker'
+ end
+ object lblComments: TLabel
+ Left = 12
+ Top = 83
+ Width = 50
+ Height = 13
+ Caption = 'Comme&nts'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ end
+ object cbFormat: TComboBox
+ Left = 98
+ Top = 26
+ Width = 145
+ Height = 21
+ Style = csDropDownList
+ TabOrder = 0
+ OnClick = cbFormatClick
+ Items.Strings = (
+ 'Wordlist (trie-1.0)'
+ 'Custom (custom-1.0)')
+ end
+ object cbWordBreaker: TComboBox
+ Left = 98
+ Top = 53
+ Width = 145
+ Height = 21
+ Style = csDropDownList
+ TabOrder = 1
+ OnClick = cbWordBreakerClick
+ Items.Strings = (
+ 'default'
+ 'ascii'
+ 'custom')
+ end
+ object memoComments: TMemo
+ Left = 98
+ Top = 80
+ Width = 506
+ Height = 87
+ Anchors = [akLeft, akTop, akRight]
+ BevelOuter = bvNone
+ TabOrder = 2
+ OnChange = memoCommentsChange
+ end
+ end
+ end
+ end
+ object pageSource: TTabSheet
+ Caption = 'Source'
+ ImageIndex = 9
+ end
+ object pageCompile: TTabSheet
+ Caption = 'Build'
+ ImageIndex = 1
+ object Panel1: TPanel
+ Left = 0
+ Top = 0
+ Width = 619
+ Height = 708
+ Align = alClient
+ BevelOuter = bvNone
+ Color = 14211288
+ ParentBackground = False
+ TabOrder = 0
+ object lblCongrats: TLabel
+ Left = 10
+ Top = 13
+ Width = 333
+ Height = 13
+ Caption =
+ 'The keyboard must be compiled in order to distribute or install ' +
+ 'it'
+ end
+ object Label5: TLabel
+ Left = 10
+ Top = 79
+ Width = 82
+ Height = 13
+ Caption = 'Target filename:'
+ end
+ object cmdCompile: TButton
+ Left = 10
+ Top = 40
+ Width = 137
+ Height = 25
+ Action = modActionsModelEditor.actModelCompile
+ TabOrder = 0
+ end
+ object cmdAddToProject: TButton
+ Left = 297
+ Top = 40
+ Width = 137
+ Height = 25
+ Action = modActionsMain.actProjectAddCurrentEditorFile
+ TabOrder = 1
+ end
+ object cmdOpenContainingFolder2: TButton
+ Left = 153
+ Top = 40
+ Width = 138
+ Height = 25
+ Caption = '&Open Containing Folder'
+ TabOrder = 2
+ OnClick = cmdOpenContainingFolder2Click
+ end
+ object panBuildLexicalModel: TPanel
+ Left = 10
+ Top = 112
+ Width = 424
+ Height = 353
+ BevelOuter = bvNone
+ Color = 15921906
+ ParentBackground = False
+ TabOrder = 3
+ object lblDebugHostCaption: TLabel
+ Left = 12
+ Top = 158
+ Width = 252
+ Height = 13
+ Caption = 'Debug host is active at following web addresses:'
+ end
+ object lblCrossPlatform: TLabel
+ Left = 12
+ Top = 14
+ Width = 237
+ Height = 17
+ Caption = 'Test Lexical Model in Web Browser'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -14
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object Label1: TLabel
+ Left = 12
+ Top = 48
+ Width = 105
+ Height = 13
+ Caption = 'Keyboard for testing'
+ end
+ object Label2: TLabel
+ Left = 12
+ Top = 72
+ Width = 389
+ Height = 26
+ Caption =
+ 'Optionally, select a compiled keyboard with which to test this l' +
+ 'exical model. Any keyboards already loaded in the web debugger w' +
+ 'ill also be available.'
+ WordWrap = True
+ end
+ object cmdTestLexicalModel: TButton
+ Left = 12
+ Top = 122
+ Width = 150
+ Height = 25
+ Action = modActionsModelEditor.actModelTest
+ TabOrder = 2
+ end
+ object cmdOpenDebugHost: TButton
+ Left = 12
+ Top = 286
+ Width = 189
+ Height = 25
+ Caption = 'Open &debugger in local browser'
+ TabOrder = 3
+ OnClick = cmdOpenDebugHostClick
+ end
+ object lbDebugHosts: TListBox
+ Left = 12
+ Top = 183
+ Width = 289
+ Height = 97
+ ItemHeight = 13
+ TabOrder = 4
+ end
+ object cmdSendURLsToEmail: TButton
+ Left = 12
+ Top = 317
+ Width = 189
+ Height = 25
+ Caption = 'Send addresses to &email...'
+ TabOrder = 5
+ OnClick = cmdSendURLsToEmailClick
+ end
+ object editTestKeyboard: TEdit
+ Left = 123
+ Top = 45
+ Width = 158
+ Height = 21
+ TabOrder = 0
+ OnChange = editTestKeyboardChange
+ end
+ object cmdBrowseTestKeyboard: TButton
+ Left = 287
+ Top = 43
+ Width = 75
+ Height = 25
+ Caption = '&Browse...'
+ TabOrder = 1
+ OnClick = cmdBrowseTestKeyboardClick
+ end
+ end
+ object editOutPath: TEdit
+ Left = 98
+ Top = 76
+ Width = 383
+ Height = 21
+ TabStop = False
+ ParentColor = True
+ ReadOnly = True
+ TabOrder = 4
+ end
+ end
+ end
+ end
+ object dlgAddWordlist: TOpenDialog
+ Options = [ofHideReadOnly, ofPathMustExist, ofEnableSizing]
+ Title = 'Create or Add Wordlist'
+ Left = 344
+ Top = 344
+ end
+ object dlgBrowseTestKeyboard: TOpenDialog
+ DefaultExt = 'js'
+ Filter = 'Compiled keyboard files (*.js)|*.js|All files (*.*)|*.*'
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Title = 'Select compiled keyboard to test with'
+ Left = 488
+ Top = 120
+ end
+end
diff --git a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmModelEditor.pas b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmModelEditor.pas
new file mode 100644
index 0000000000..2e0084f54c
--- /dev/null
+++ b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmModelEditor.pas
@@ -0,0 +1,569 @@
+//TODO: CEF destruction is incorrect in this unit
+unit Keyman.Developer.UI.UfrmModelEditor;
+
+interface
+
+uses
+ System.Classes,
+ System.Generics.Collections,
+ System.SysUtils,
+ System.Variants,
+ Vcl.ComCtrls,
+ Vcl.Controls,
+ Vcl.Dialogs,
+ Vcl.ExtCtrls,
+ Vcl.Forms,
+ Vcl.Graphics,
+ Vcl.Grids,
+ Vcl.StdCtrls,
+ Winapi.Messages,
+ Winapi.Windows,
+
+ Keyman.Developer.UI.dmActionsModelEditor,
+ dmActionsMain,
+ LeftTabbedPageControl,
+ UfrmMDIEditor,
+ UframeTextEditor,
+ Keyman.Developer.System.Project.ProjectFile,
+ Keyman.Developer.System.Project.modeltsProjectFile,
+ Keyman.Developer.UI.Project.modeltsProjectFileUI,
+
+ Keyman.Developer.UI.UframeWordlistEditor,
+ Keyman.Developer.System.LexicalModelParser,
+ Keyman.Developer.System.LexicalModelParserTypes;
+
+type
+ TfrmModelEditor = class(TfrmTikeEditor)
+ pages: TLeftTabbedPageControl;
+ pageDetails: TTabSheet;
+ sbDetails: TScrollBox;
+ panWordlists: TPanel;
+ lblWordlists: TLabel;
+ gridWordlists: TStringGrid;
+ cmdAddWordlist: TButton;
+ cmdRemoveWordlist: TButton;
+ panBasicInformation: TPanel;
+ lblFormat: TLabel;
+ lblBasicInformation: TLabel;
+ pageSource: TTabSheet;
+ pageCompile: TTabSheet;
+ Panel1: TPanel;
+ lblCongrats: TLabel;
+ cmdCompile: TButton;
+ cmdAddToProject: TButton;
+ cmdOpenContainingFolder2: TButton;
+ panBuildLexicalModel: TPanel;
+ cbFormat: TComboBox;
+ cbWordBreaker: TComboBox;
+ lblWordBreaker: TLabel;
+ memoComments: TMemo;
+ lblComments: TLabel;
+ lblDebugHostCaption: TLabel;
+ lblCrossPlatform: TLabel;
+ cmdTestLexicalModel: TButton;
+ cmdOpenDebugHost: TButton;
+ lbDebugHosts: TListBox;
+ cmdSendURLsToEmail: TButton;
+ Label1: TLabel;
+ editTestKeyboard: TEdit;
+ cmdBrowseTestKeyboard: TButton;
+ Label2: TLabel;
+ lblReadOnly: TLabel;
+ dlgAddWordlist: TOpenDialog;
+ dlgBrowseTestKeyboard: TOpenDialog;
+ Label5: TLabel;
+ editOutPath: TEdit;
+ procedure FormDestroy(Sender: TObject);
+ procedure cmdAddWordlistClick(Sender: TObject);
+ procedure cmdRemoveWordlistClick(Sender: TObject);
+ procedure gridWordlistsDblClick(Sender: TObject);
+ procedure pagesChanging(Sender: TObject; var AllowChange: Boolean);
+ procedure FormCreate(Sender: TObject);
+ procedure cbFormatClick(Sender: TObject);
+ procedure cbWordBreakerClick(Sender: TObject);
+ procedure memoCommentsChange(Sender: TObject);
+ procedure cmdOpenContainingFolder2Click(Sender: TObject);
+ procedure cmdOpenDebugHostClick(Sender: TObject);
+ procedure cmdSendURLsToEmailClick(Sender: TObject);
+ procedure cmdBrowseTestKeyboardClick(Sender: TObject);
+ procedure editTestKeyboardChange(Sender: TObject);
+ private
+ type
+ TWordlist = class
+ Frame: TframeWordlistEditor;
+ Tab: TTabSheet;
+ Filename: string;
+ destructor Destroy; override;
+ end;
+ TWordlists = class(TObjectList)
+ public
+ function IndexOfFilename(const Filename: string): Integer;
+ end;
+ private
+ model: TStrings;
+ parser: TLexicalModelParser;
+ wordlists: TWordlists;
+ frameSource: TframeTextEditor;
+ FSetup: Integer;
+ procedure FillDetails;
+ procedure EnableControls;
+ procedure UpdateWordlistTabs;
+ function AddWordlistTab(
+ const WordlistFilename: string): TfrmModelEditor.TWordlist;
+ function MoveDesignToSource: Boolean;
+ function MoveSourceToDesign: Boolean;
+ procedure SourceChanged(Sender: TObject);
+ function CheckModifiedWordlistsForRemoval(
+ newParser: TLexicalModelParser): Boolean;
+ { Private declarations }
+ protected
+ function GetHelpTopic: string; override;
+ function DoOpenFile: Boolean; override;
+ function DoSaveFile: Boolean; override;
+ function GetFileNameFilter: string; override;
+ function GetDefaultExt: string; override;
+
+ function GetProjectFile: TProjectFile; override;
+
+ public
+ procedure FindError(const Filename: string; s: string; line: Integer); override; // I4081
+ procedure NotifyStartedWebDebug;
+ end;
+
+implementation
+
+uses
+ System.UITypes,
+ Keyman.Developer.System.Project.modeltsProjectFileAction,
+ TextFileFormat,
+ UmodWebHttpServer,
+ UfrmSendURLsToEmail,
+ utilexecute,
+ utilsystem;
+
+{$R *.dfm}
+
+function FormatToIndex(format: TLexicalModelFormat): Integer;
+begin
+ Result := Ord(format) - 1; // unknown = -1
+end;
+
+function WordBreakerToIndex(wordBreaker: TLexicalModelWordBreaker): Integer;
+begin
+ Result := Ord(wordBreaker) - 1; // unknown = -1
+end;
+
+function FormatFromIndex(format: Integer): TLexicalModelFormat;
+begin
+ Result := TLexicalModelFormat(format+1); // unknown = -1
+end;
+
+function WordBreakerFromIndex(wordBreaker: Integer): TLexicalModelWordBreaker;
+begin
+ Result := TLexicalModelWordBreaker(wordBreaker+1); // unknown = -1
+end;
+
+{ TfrmModelEditor }
+
+function TfrmModelEditor.DoOpenFile: Boolean;
+begin
+ model := TStringList.Create;
+ model.LoadFromFile(FileName);
+ parser := TLexicalModelParser.Create(model.Text);
+ wordlists := TWordlists.Create;
+
+ Inc(FSetup);
+ try
+ FillDetails;
+ UpdateWordlistTabs;
+ finally
+ Dec(FSetup);
+ end;
+
+ Result := True;
+end;
+
+function TfrmModelEditor.DoSaveFile: Boolean;
+var
+ wordlist: TWordlist;
+begin
+ for wordlist in wordlists do
+ begin
+ wordlist.Frame.SaveToFile(wordlist.Frame.Filename);
+ end;
+
+ model.Text := parser.Text;
+ model.SaveToFile(FileName);
+
+ editOutPath.Text := (ProjectFile as TmodelTsProjectFile).TargetFilename; // I4688
+
+ Result := True;
+end;
+
+procedure TfrmModelEditor.editTestKeyboardChange(Sender: TObject);
+begin
+ if FSetup > 0 then
+ Exit;
+ (ProjectFile as TmodelTsProjectFile).TestKeyboard := editTestKeyboard.Text;
+end;
+
+procedure TfrmModelEditor.EnableControls;
+var
+ e: Boolean;
+begin
+ e := parser.IsEditable;
+
+ { Details tab }
+
+ lblFormat.Enabled := e;
+ cbFormat.Enabled := e;
+ lblWordBreaker.Enabled := e;
+ cbWordBreaker.Enabled := e;
+ lblComments.Enabled := e;
+ memoComments.Enabled := e;
+ cmdAddWordlist.Enabled := e;
+ gridWordlists.Enabled := e and (parser.Wordlists.Count > 0);
+ cmdRemoveWordlist.Enabled := e and (parser.Wordlists.Count > 0);
+ lblReadOnly.Visible := not e;
+
+ { Build tab }
+ cmdOpenDebugHost.Enabled := lbDebugHosts.ItemIndex >= 0;
+ cmdSendURLsToEmail.Enabled := lbDebugHosts.Items.Count > 0; // I4506
+end;
+
+procedure TfrmModelEditor.NotifyStartedWebDebug;
+begin
+ lbDebugHosts.Clear;
+ modWebHttpServer.GetURLs(lbDebugHosts.Items);
+ if lbDebugHosts.Items.Count > 0 then
+ lbDebugHosts.ItemIndex := 0;
+ EnableControls;
+end;
+
+procedure TfrmModelEditor.FindError(const Filename: string; s: string;
+ line: Integer);
+begin
+ inherited;
+ // TODO
+end;
+
+procedure TfrmModelEditor.FormCreate(Sender: TObject);
+begin
+ inherited;
+ Inc(FSetup);
+ try
+ frameSource := TframeTextEditor.Create(Self);
+ frameSource.Parent := pageSource;
+
+ frameSource.Align := alClient;
+ frameSource.EditorFormat := efJS;
+ frameSource.Visible := True;
+ frameSource.OnChanged := SourceChanged;
+ frameSource.TextFileFormat := tffUTF8;
+
+ pages.ActivePage := pageDetails;
+ finally
+ Dec(FSetup);
+ end;
+end;
+
+procedure TfrmModelEditor.FormDestroy(Sender: TObject);
+begin
+ inherited;
+ FreeAndNil(parser);
+ FreeAndNil(model);
+ FreeAndNil(wordlists);
+end;
+
+function TfrmModelEditor.GetDefaultExt: string;
+begin
+ Result := '.model.ts'; // TODO: test if this actually works!
+end;
+
+function TfrmModelEditor.GetFileNameFilter: string;
+begin
+ Result := 'Lexical model files (*.model.ts)|*.model.ts|All files (*.*)|*.*';
+end;
+
+function TfrmModelEditor.GetHelpTopic: string;
+begin
+ Result := ''; //SHelpTopic_Context_WordlistEditor; // TODO: use a better topic
+end;
+
+function TfrmModelEditor.GetProjectFile: TProjectFile;
+begin
+ Result := inherited GetProjectFile;
+ if not Assigned(Result) then
+ begin
+ FStandaloneProjectFile := TmodelTsProjectFileAction.Create(nil, FileName, nil);
+ Result := FStandaloneProjectFile;
+ end;
+end;
+
+procedure TfrmModelEditor.gridWordlistsDblClick(Sender: TObject);
+begin
+ pages.ActivePageIndex := gridWordlists.Row + 1;
+end;
+
+procedure TfrmModelEditor.memoCommentsChange(Sender: TObject);
+begin
+ if FSetup > 0 then
+ Exit;
+ parser.Comment := memoComments.Text;
+ Modified := True;
+end;
+
+procedure TfrmModelEditor.SourceChanged(Sender: TObject);
+begin
+ if FSetup > 0 then
+ Exit;
+ Modified := True;
+end;
+
+function TfrmModelEditor.CheckModifiedWordlistsForRemoval(newParser: TLexicalModelParser): Boolean;
+var
+ wordlist: TWordlist;
+begin
+ for wordlist in wordlists do
+ begin
+ if (newParser.Wordlists.IndexOf(wordlist.Filename) < 0) and
+ wordlist.Frame.Modified then
+ begin
+ case MessageDlg(Format('The wordlist %s has been removed but has been modified. Save changes before removal?',
+ [ExtractFileName(wordlist.Filename)]), mtConfirmation, mbYesNoCancel, 0) of
+ mrYes: wordlist.Frame.SaveToFile(wordlist.Frame.Filename);
+ mrNo: ;
+ mrCancel: Exit(False);
+ end;
+ end;
+ end;
+
+ Result := True;
+end;
+
+function TfrmModelEditor.MoveSourceToDesign: Boolean;
+var
+ newParser: TLexicalModelParser;
+begin
+ Inc(FSetup);
+ try
+ newParser := TLexicalModelParser.Create(frameSource.EditorText);
+ if not CheckModifiedWordlistsForRemoval(newParser) then
+ begin
+ FreeAndNil(newParser);
+ Exit(False);
+ end;
+ FreeAndNil(parser);
+ parser := newParser;
+ FillDetails;
+ UpdateWordlistTabs;
+ finally
+ Dec(FSetup);
+ end;
+ Result := True;
+end;
+
+function TfrmModelEditor.MoveDesignToSource: Boolean;
+begin
+ frameSource.EditorText := parser.Text;
+ Result := True;
+end;
+
+procedure TfrmModelEditor.pagesChanging(Sender: TObject;
+ var AllowChange: Boolean);
+begin
+ if FSetup > 0 then Exit;
+
+ if pages.ActivePage = pageSource then
+ AllowChange := MoveSourceToDesign
+ else
+ AllowChange := MoveDesignToSource
+end;
+
+{ --------- Details tab --------- }
+
+procedure TfrmModelEditor.FillDetails;
+var
+ i: Integer;
+begin
+ cbFormat.ItemIndex := FormatToIndex(parser.Format);
+ cbWordBreaker.ItemIndex := WordBreakerToIndex(parser.WordBreaker);
+ memoComments.Text := parser.Comment;
+
+ if parser.Wordlists.Count = 0 then
+ begin
+ gridWordlists.RowCount := 1;
+ gridWordlists.Cells[0, 0] := '';
+ end
+ else
+ begin
+ gridWordlists.RowCount := parser.Wordlists.Count;
+ for i := 0 to parser.Wordlists.Count - 1 do
+ begin
+ gridWordlists.Cells[0, i] := parser.Wordlists[i];
+ end;
+ end;
+
+ editOutPath.Text := (ProjectFile as TmodelTsProjectFile).TargetFilename; // I4688
+ editTestKeyboard.Text := (ProjectFile as TmodelTsProjectFile).TestKeyboard;
+
+ EnableControls;
+end;
+
+procedure TfrmModelEditor.UpdateWordlistTabs;
+var
+ i, n: Integer;
+ wordlist: TWordlist;
+begin
+ // Remove tabs that are no longer listed
+ for i := wordlists.Count - 1 downto 0 do
+ begin
+ if parser.Wordlists.IndexOf(wordlists[i].Filename) < 0 then
+ wordlists.Delete(i);
+ end;
+
+ // Add new tabs
+ for i := 0 to parser.Wordlists.Count - 1 do
+ begin
+ n := wordlists.IndexOfFilename(parser.Wordlists[i]);
+ if n < 0 then
+ begin
+ wordlist := AddWordlistTab(parser.Wordlists[i]);
+ wordlist.Tab.PageIndex := i + 1;
+ end
+ else
+ wordlists[n].Tab.PageIndex := i + 1;
+ end;
+end;
+
+function TfrmModelEditor.AddWordlistTab(const WordlistFilename: string): TfrmModelEditor.TWordlist;
+begin
+ Result := TWordlist.Create;
+
+ wordlists.Add(Result);
+ Result.Filename := WordlistFilename;
+
+ Result.Tab := TTabSheet.Create(Self);
+ Result.Tab.TabVisible := True;
+ Result.Tab.ImageIndex := 17; // 'spreadsheet'
+ Result.Tab.Caption := ExtractFileName(Result.Filename);
+ Result.Tab.PageControl := pages;
+
+ Result.Frame := TframeWordlistEditor.Create(Self);
+ Result.Frame.LoadFromFile(ExtractFilePath(Filename) + WordlistFilename);
+ Result.Frame.Align := alClient;
+
+ Result.Frame.Parent := Result.Tab;
+ Result.Frame.Visible := True;
+end;
+
+{ TfrmModelEditor.TWordlists }
+
+function TfrmModelEditor.TWordlists.IndexOfFilename(
+ const Filename: string): Integer;
+begin
+ for Result := 0 to Count - 1 do
+ if SameText(Items[Result].Filename, Filename) then
+ Exit;
+ Result := -1;
+end;
+
+{ Wordlist management }
+
+procedure TfrmModelEditor.cbFormatClick(Sender: TObject);
+begin
+ if FSetup > 0 then
+ Exit;
+ parser.Format := FormatFromIndex(cbFormat.ItemIndex);
+ Modified := True;
+end;
+
+procedure TfrmModelEditor.cbWordBreakerClick(Sender: TObject);
+begin
+ if FSetup > 0 then
+ Exit;
+ parser.WordBreaker := WordBreakerFromIndex(cbWordBreaker.ItemIndex);
+ Modified := True;
+end;
+
+procedure TfrmModelEditor.cmdAddWordlistClick(Sender: TObject);
+begin
+ if dlgAddWordlist.Execute then
+ begin
+ parser.Wordlists.Add(ExtractRelativePath(Filename, dlgAddWordlist.FileName));
+ Inc(FSetup);
+ try
+ FillDetails;
+ UpdateWordlistTabs;
+ finally
+ Dec(FSetup);
+ end;
+ Modified := True;
+ end;
+end;
+
+procedure TfrmModelEditor.cmdBrowseTestKeyboardClick(Sender: TObject);
+begin
+ if dlgBrowseTestKeyboard.Execute then
+ editTestKeyboard.Text := dlgBrowseTestKeyboard.FileName;
+end;
+
+procedure TfrmModelEditor.cmdOpenContainingFolder2Click(Sender: TObject);
+begin
+ OpenContainingFolder(FileName);
+end;
+
+procedure TfrmModelEditor.cmdOpenDebugHostClick(Sender: TObject);
+begin
+ TUtilExecute.URL(lbDebugHosts.Items[lbDebugHosts.ItemIndex]);
+end;
+
+procedure TfrmModelEditor.cmdRemoveWordlistClick(Sender: TObject);
+var
+ wordlist: TWordlist;
+begin
+ wordlist := wordlists[gridWordlists.Row];
+ if wordlist.Frame.Modified then
+ begin
+ case MessageDlg(Format('Save changes to wordlist %s before removing it?',
+ [ExtractFileName(wordlist.Filename)]),
+ mtConfirmation, mbYesNoCancel, 0) of
+ mrYes: wordlist.Frame.SaveToFile(wordlist.Frame.Filename);
+ mrNo: ;
+ mrCancel: Exit;
+ end;
+ end;
+
+ parser.Wordlists.Delete(gridWordlists.Row);
+ Inc(FSetup);
+ try
+ FillDetails;
+ UpdateWordlistTabs;
+ finally
+ Dec(FSetup);
+ end;
+ Modified := True;
+end;
+
+procedure TfrmModelEditor.cmdSendURLsToEmailClick(Sender: TObject);
+begin
+ with TfrmSendURLsToEmail.Create(Application.MainForm) do
+ try
+ //TODO: KeyboardName := Self.FKeyboardParser.GetSystemStoreValue(ssName);
+ Hosts.Assign(lbDebugHosts.Items);
+ ShowModal;
+ finally
+ Free;
+ end;
+end;
+
+{ TfrmModelEditor.TWordlist }
+
+destructor TfrmModelEditor.TWordlist.Destroy;
+begin
+ Frame.Free;
+ Tab.Free;
+ inherited Destroy;
+end;
+
+end.
diff --git a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.dfm b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.dfm
index b7bd1388c6..428f6fdfcb 100644
--- a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.dfm
+++ b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.dfm
@@ -5,74 +5,8 @@ inherited frmWordlistEditor: TfrmWordlistEditor
ClientHeight = 299
ClientWidth = 635
Font.Name = 'Tahoma'
- OnResize = FormResize
ExplicitWidth = 635
ExplicitHeight = 299
PixelsPerInch = 96
TextHeight = 13
- object pages: TPageControl
- Left = 0
- Top = 0
- Width = 635
- Height = 299
- ActivePage = pageDesign
- Align = alClient
- TabOrder = 0
- TabPosition = tpBottom
- OnChanging = pagesChanging
- object pageDesign: TTabSheet
- Caption = 'Design'
- ImageIndex = -1
- object gridWordlist: TStringGridEditControlled
- Left = 0
- Top = 0
- Width = 627
- Height = 232
- Align = alClient
- ColCount = 3
- DefaultRowHeight = 16
- DefaultDrawing = False
- FixedCols = 0
- Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goEditing, goTabs, goAlwaysShowEditor]
- TabOrder = 0
- OnClick = gridWordlistClick
- OnDrawCell = gridWordlistDrawCell
- OnSetEditText = gridWordlistSetEditText
- ExplicitHeight = 273
- end
- object panGridControls: TPanel
- Left = 0
- Top = 232
- Width = 627
- Height = 41
- Align = alBottom
- TabOrder = 1
- ExplicitLeft = 224
- ExplicitTop = 120
- ExplicitWidth = 185
- object cmdDeleteRow: TButton
- Left = 0
- Top = 6
- Width = 75
- Height = 25
- Caption = '&Delete row'
- TabOrder = 0
- OnClick = cmdDeleteRowClick
- end
- object cmdSortByFrequency: TButton
- Left = 81
- Top = 6
- Width = 104
- Height = 25
- Caption = '&Sort by frequency'
- TabOrder = 1
- OnClick = cmdSortByFrequencyClick
- end
- end
- end
- object pageCode: TTabSheet
- Caption = 'Code'
- ImageIndex = -1
- end
- end
end
diff --git a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.pas b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.pas
index 29d534a648..b1795f6069 100644
--- a/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.pas
+++ b/windows/src/developer/TIKE/child/Keyman.Developer.UI.UfrmWordlistEditor.pas
@@ -13,46 +13,17 @@ uses
Vcl.Dialogs,
Vcl.Forms,
Vcl.Graphics,
- Vcl.Grids,
- StringGridEditControlled,
-
- Keyman.System.WordlistTsvFile,
- UframeTextEditor,
- UfrmMDIEditor, Vcl.StdCtrls, Vcl.ExtCtrls;
+ Keyman.Developer.UI.UframeWordlistEditor,
+ UfrmMDIEditor;
type
TfrmWordlistEditor = class(TfrmTikeEditor)
- pages: TPageControl;
- pageDesign: TTabSheet;
- pageCode: TTabSheet;
- gridWordlist: TStringGridEditControlled;
- panGridControls: TPanel;
- cmdDeleteRow: TButton;
- cmdSortByFrequency: TButton;
- procedure pagesChanging(Sender: TObject; var AllowChange: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
- procedure FormResize(Sender: TObject);
- procedure gridWordlistSetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: string);
- procedure gridWordlistDrawCell(Sender: TObject; ACol, ARow: Integer;
- ARect: TRect; State: TGridDrawState);
- procedure cmdDeleteRowClick(Sender: TObject);
- procedure gridWordlistClick(Sender: TObject);
- procedure cmdSortByFrequencyClick(Sender: TObject);
private
- FWordlist: TWordlistTsvFile;
- frameSource: TframeTextEditor;
- FSetup: Integer;
- procedure UpdateData;
- function MoveCodeToWordlist: Boolean;
- procedure FillCode;
- procedure FillGrid;
- function MoveDesignToWordlist: Boolean;
- procedure SourceChanged(Sender: TObject);
- procedure FillGridNewRow;
- procedure EnableControls;
+ frame: TframeWordlistEditor;
+ procedure FrameModified(Sender: TObject);
protected
function GetHelpTopic: string; override;
function DoOpenFile: Boolean; override;
@@ -74,97 +45,41 @@ uses
UfrmMain,
UfrmMessages;
-const
- ColWidth_Word = 120;
- ColWidth_Frequency = 64;
- S_AddRowText = 'Add word...';
-
{ TfrmWordlistEditor }
procedure TfrmWordlistEditor.FormCreate(Sender: TObject);
begin
inherited;
- Inc(FSetup);
- try
- FWordlist := TWordlistTsvFile.Create;
- frameSource := TframeTextEditor.Create(Self);
- frameSource.Parent := pageCode;
- frameSource.Align := alClient;
- frameSource.EditorFormat := efWordlistTsv;
- frameSource.Visible := True;
- frameSource.OnChanged := SourceChanged;
- frameSource.TextFileFormat := tffUTF8;
-//TODO: frameSource.UseTabs := True;
- pages.ActivePage := pageDesign;
-
- gridWordlist.Cells[0, 0] := 'Word Form';
- gridWordlist.Cells[1, 0] := 'Count';
- gridWordlist.Cells[2, 0] := 'Comment';
- gridWordlist.ColWidths[0] := ColWidth_Word;
- gridWordlist.ColWidths[1] := ColWidth_Frequency;
- gridWordlist.ColWidths[2] := gridWordlist.ClientWidth - ColWidth_Word - ColWidth_Frequency - 2;
- finally
- Dec(FSetup);
- end;
+ frame := TframeWordlistEditor.Create(Self);
+ frame.Align := alClient;
+ frame.Parent := Self;
+ frame.OnModifiedChanged := FrameModified;
end;
procedure TfrmWordlistEditor.FormDestroy(Sender: TObject);
begin
inherited;
- FWordlist.Free;
+ frame.Free;
end;
-procedure TfrmWordlistEditor.FormResize(Sender: TObject);
+procedure TfrmWordlistEditor.FrameModified(Sender: TObject);
begin
- inherited;
- gridWordlist.ColWidths[2] := gridWordlist.ClientWidth - ColWidth_Word - ColWidth_Frequency - 2;
-end;
-
-procedure TfrmWordlistEditor.cmdDeleteRowClick(Sender: TObject);
-begin
- FWordlist.RemoveWord(gridWordlist.Row-1);
- FillGrid;
- EnableControls;
- Modified := True;
-end;
-
-procedure TfrmWordlistEditor.cmdSortByFrequencyClick(Sender: TObject);
-begin
- FWordlist.SortByFrequency;
- FillGrid;
- Modified := True;
+ Modified := frame.Modified;
end;
function TfrmWordlistEditor.DoOpenFile: Boolean;
begin
- RefreshOptions;
- if FileExists(FileName) then
- begin
- FWordlist.LoadFromFile(FileName);
- UpdateData;
- end;
- Result := True;
+ Result := frame.LoadFromFile(Filename);
end;
function TfrmWordlistEditor.DoSaveFile: Boolean;
begin
- MoveCodeToWordlist; // Does nothing if not in code page
- FWordlist.SaveToFile(FileName);
- Result := True;
-end;
-
-procedure TfrmWordlistEditor.EnableControls;
-var
- e: Boolean;
-begin
- e := gridWordlist.Row < gridWordlist.RowCount - 1;
- cmdDeleteRow.Enabled := e;
- cmdSortByFrequency.Enabled := e;
+ Result := frame.SaveToFile(Filename);
end;
procedure TfrmWordlistEditor.FindError(const Filename: string; s: string; line: Integer);
begin
- //
+ frame.FindError(Filename, s, line);
end;
function TfrmWordlistEditor.GetDefaultExt: string;
@@ -182,142 +97,4 @@ begin
Result := SHelpTopic_Context_WordlistEditor;
end;
-procedure TfrmWordlistEditor.gridWordlistClick(Sender: TObject);
-begin
- EnableControls;
-end;
-
-procedure TfrmWordlistEditor.gridWordlistDrawCell(Sender: TObject; ACol,
- ARow: Integer; ARect: TRect; State: TGridDrawState);
-var
- LText: string;
-begin
- inherited;
- if ARow = gridWordlist.RowCount - 1 then
- begin
- // Drawing last row
- gridWordlist.Canvas.Font.Style := [fsItalic];
- end
- else if gridWordlist.Cells[0, ARow] = '#' then
- begin
- // Drawing a comment cell
- gridWordlist.Canvas.Font.Style := [fsBold];
- end
- else
- gridWordlist.Canvas.Font.Style := [];
-
- LText := gridWordlist.Cells[ACol, ARow];
- gridWordlist.Canvas.TextRect(ARect, ARect.Left+2,
- ARect.Top+((ARect.Height - gridWordlist.Canvas.TextHeight(LText)) div 2), LText);
-end;
-
-procedure TfrmWordlistEditor.gridWordlistSetEditText(Sender: TObject; ACol,
- ARow: Integer; const Value: string);
-var
- w: TWordlistWord;
-begin
- if FSetup > 0 then Exit;
- Inc(FSetup);
- try
- Modified := True;
-
- if ARow = gridWordlist.RowCount - 1 then
- begin
- if (Value = '') or (Value = S_AddRowText) then
- Exit;
-
- w.Word := Value;
- w.Frequency := 0;
- w.Comment := '';
- FWordlist.AddWord(w);
- gridWordlist.RowCount := gridWordlist.RowCount + 1;
- FillGridNewRow;
- end
- else
- begin
- w := FWordlist.Word[ARow-1];
- case ACol of
- 0: w.Word := Value;
- 1: w.Frequency := StrToIntDef(Value, 0);
- 2: w.Comment := Value;
- end;
- FWordlist.Word[ARow-1] := w;
- end;
- finally
- Dec(FSetup);
- end;
-end;
-
-procedure TfrmWordlistEditor.pagesChanging(Sender: TObject;
- var AllowChange: Boolean);
-begin
- if FSetup > 0 then Exit;
-
- if pages.ActivePage = pageCode then
- AllowChange := MoveCodeToWordlist
- else
- AllowChange := MoveDesignToWordlist
-end;
-
-function TfrmWordlistEditor.MoveCodeToWordlist: Boolean;
-begin
- if pages.ActivePage <> pageCode then
- Exit(False);
-
- FWordlist.Text := frameSource.EditorText;
- FillGrid;
- Result := True;
-end;
-
-function TfrmWordlistEditor.MoveDesignToWordlist: Boolean;
-begin
- FillCode;
- Result := True;
-end;
-
-procedure TfrmWordlistEditor.UpdateData;
-begin
- if pages.ActivePage = pageCode
- then FillCode
- else FillGrid;
-end;
-
-procedure TfrmWordlistEditor.SourceChanged(Sender: TObject);
-begin
- if FSetup = 0 then
- Modified := True;
-end;
-
-procedure TfrmWordlistEditor.FillCode;
-begin
- frameSource.EditorText := FWordlist.Text;
-end;
-
-procedure TfrmWordlistEditor.FillGrid;
-var
- i: Integer;
- w: TWordlistWord;
-begin
- gridWordlist.RowCount := FWordlist.Count + 2;
- for i := 0 to FWordlist.Count - 1 do
- begin
- w := FWordlist.Word[i];
- gridWordlist.Cells[0, i+1] := w.Word;
- if w.Frequency = 0
- then gridWordlist.Cells[1, i+1] := ''
- else gridWordlist.Cells[1, i+1] := IntToStr(w.Frequency);
- gridWordlist.Cells[2, i+1] := w.Comment;
- end;
- FillGridNewRow;
- gridWordlist.FixedRows := 1;
-end;
-
-procedure TfrmWordlistEditor.FillGridNewRow;
-begin
- gridWordlist.Cells[0, gridWordlist.RowCount - 1] := S_AddRowText;
- gridWordlist.Cells[1, gridWordlist.RowCount - 1] := '';
- gridWordlist.Cells[2, gridWordlist.RowCount - 1] := '';
- EnableControls;
-end;
-
end.
diff --git a/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm b/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm
index fb5c8162ef..6c74d2f359 100644
--- a/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm
+++ b/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm
@@ -1119,6 +1119,9 @@ inherited frmPackageEditor: TfrmPackageEditor
object pageSource: TTabSheet
Caption = 'Source'
ImageIndex = 9
+ ExplicitLeft = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
end
object pageCompile: TTabSheet
Caption = 'Compile'
diff --git a/windows/src/developer/TIKE/child/UfrmPackageEditor.pas b/windows/src/developer/TIKE/child/UfrmPackageEditor.pas
index bbe14af965..ffdd6c8e49 100644
--- a/windows/src/developer/TIKE/child/UfrmPackageEditor.pas
+++ b/windows/src/developer/TIKE/child/UfrmPackageEditor.pas
@@ -1672,7 +1672,7 @@ var
FHasDesktopTarget, FHasMobileTarget: Boolean;
begin
FHasDesktopTarget := False;
- FHasMobileTarget := False;
+ FHasMobileTarget := pack.LexicalModels.Count > 0;
for k in pack.Keyboards do
begin
for i := 0 to pack.Files.Count - 1 do
diff --git a/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Debugger.pas b/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Debugger.pas
index 27d36a816c..9ad35f5bc5 100644
--- a/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Debugger.pas
+++ b/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Debugger.pas
@@ -54,13 +54,23 @@ type
property Name: string read FName;
end;
+ TWebDebugModelInfo = class
+ strict private
+ FFilename: string;
+ public
+ constructor Create(const AFilename: string);
+ property Filename: string read FFilename;
+ end;
+
TDebuggerHttpResponder = class(TBaseHttpResponder)
private
- FKeyboardsCS, FPackagesCS: TCriticalSection; // I4036
+ FModelsCS, FKeyboardsCS, FPackagesCS: TCriticalSection; // I4036
+ FModels: TObjectDictionary;
FKeyboards: TObjectDictionary; // I4063
FPackages: TObjectDictionary;
function GetKeyboardStoredFileName(const WebFilename: string): string;
function GetPackageStoredFileName(const WebFilename: string): string;
+ function GetModelStoredFileName(const WebFilename: string): string;
public
constructor Create;
destructor Destroy; override;
@@ -68,6 +78,8 @@ type
procedure UnregisterKeyboard(const Filename: string);
procedure RegisterPackage(const Filename, Name: string);
procedure UnregisterPackage(const Filename: string);
+ procedure RegisterModel(const Filename: string);
+ procedure UnregisterModel(const Filename: string);
procedure ProcessRequest(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
@@ -114,6 +126,9 @@ begin
FPackagesCS := TCriticalSection.Create;
FPackages := TObjectDictionary.Create; // I4063
+
+ FModelsCS := TCriticalSection.Create;
+ FModels := TObjectDictionary.Create; // I4063
end;
destructor TDebuggerHttpResponder.Destroy;
@@ -124,6 +139,9 @@ begin
FreeAndNil(FPackages);
FreeAndNil(FPackagesCS); // I4036
+ FreeAndNil(FModels);
+ FreeAndNil(FModelsCS); // I4036
+
inherited Destroy;
end;
@@ -139,6 +157,18 @@ begin
end;
end;
+function TDebuggerHttpResponder.GetModelStoredFileName(
+ const WebFilename: string): string;
+begin
+ FModelsCS.Enter; // I4036
+ try
+ if FModels.ContainsKey(WebFilename) then Result := FModels[WebFilename].Filename
+ else Result := '';
+ finally
+ FModelsCS.Leave;
+ end;
+end;
+
function TDebuggerHttpResponder.GetPackageStoredFileName(
const WebFilename: string): string;
begin
@@ -214,9 +244,10 @@ procedure TDebuggerHttpResponder.ProcessRequest(AContext: TIdContext;
key: string;
response: string;
value: TWebDebugKeyboardInfo;
- src: string;
+ id, src: string;
n: Integer;
srcVersion: string;
+ model: string;
begin
// Get dynamic keyboard registration
@@ -263,6 +294,17 @@ procedure TDebuggerHttpResponder.ProcessRequest(AContext: TIdContext;
FKeyboardsCS.Leave;
end;
+ FModelsCS.Enter;
+ try
+ for model in FModels.Keys do
+ begin
+ id := ChangeFileExt(model, '');
+ response := response + Format('registerModel("%s", "%s");', [id, model]);
+ end;
+ finally
+ FModelsCS.Leave;
+ end;
+
response := response + '})();';
AResponseInfo.CharSet := 'UTF-8';
@@ -605,6 +647,26 @@ begin
Exit;
end;
end
+ else if Copy(doc, 1, 6) = 'model/' then
+ begin
+ Delete(doc, 1, 6);
+
+ // Models always expire immediately
+ AResponseInfo.Expires := EncodeDate(1990, 1, 1); // I4037
+ AResponseInfo.CacheControl := 'no-cache, no-store'; // I4037
+ AResponseInfo.LastModified := Now; // I4037
+ if not FFileRegExp.Exec(doc) then
+ begin
+ Respond404;
+ Exit;
+ end;
+ doc := GetModelStoredFileName(doc);
+ if doc = '' then
+ begin
+ Respond404;
+ Exit;
+ end;
+ end
else
begin
if not FFileRegExp.Exec(doc) then
@@ -650,6 +712,19 @@ begin
end;
end;
+procedure TDebuggerHttpResponder.RegisterModel(const Filename: string);
+var
+ m: TWebDebugModelInfo;
+begin
+ m := TWebDebugModelInfo.Create(Filename);
+ FModelsCS.Enter;
+ try
+ FModels.AddOrSetValue(ExtractFileName(Filename), m);
+ finally
+ FModelsCS.Leave;
+ end;
+end;
+
procedure TDebuggerHttpResponder.RegisterPackage(const Filename, Name: string);
var
p: TWebDebugPackageInfo;
@@ -673,6 +748,16 @@ begin
end;
end;
+procedure TDebuggerHttpResponder.UnregisterModel(const Filename: string);
+begin
+ FModelsCS.Enter; // I4036
+ try
+ FModels.Remove(ExtractFileName(Filename));
+ finally
+ FModelsCS.Leave;
+ end;
+end;
+
procedure TDebuggerHttpResponder.UnregisterPackage(const Filename: string);
begin
FPackagesCS.Enter; // I4036
@@ -798,4 +883,12 @@ begin
FName := AName;
end;
+{ TWebDebugModelInfo }
+
+constructor TWebDebugModelInfo.Create(const AFilename: string);
+begin
+ inherited Create;
+ FFilename := AFilename;
+end;
+
end.
diff --git a/windows/src/developer/TIKE/main/Keyman.Developer.System.LexicalModelParser.pas b/windows/src/developer/TIKE/main/Keyman.Developer.System.LexicalModelParser.pas
new file mode 100644
index 0000000000..c21d4b5e6f
--- /dev/null
+++ b/windows/src/developer/TIKE/main/Keyman.Developer.System.LexicalModelParser.pas
@@ -0,0 +1,234 @@
+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;
+ 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);
+ 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;
+ end;
+
+implementation
+
+uses
+ System.SysUtils;
+
+{ TLexicalModelParser }
+
+const
+ SComment = '^\s*\/\*(.+?)\*\/';
+ SFormat = 'format\s*:\s*([''"])(.+?)(\1)';
+ SWordBreaker = 'wordBreaker\s*:\s*([''"])(.+?)(\1)';
+ SSources = 'sources\s*:\s*\[(.+?)\]';
+ SSource = '\s*([''"])(.+?)(\1)\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;
+
+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 := '';
+
+ 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;
+
+ FIsEditable := FIsEditable 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;
+
+procedure TLexicalModelParser.PrepareText;
+var
+ s: string;
+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]);
+
+ // 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.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.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.
diff --git a/windows/src/developer/TIKE/main/Keyman.Developer.System.LexicalModelParserTypes.pas b/windows/src/developer/TIKE/main/Keyman.Developer.System.LexicalModelParserTypes.pas
new file mode 100644
index 0000000000..07539f72f7
--- /dev/null
+++ b/windows/src/developer/TIKE/main/Keyman.Developer.System.LexicalModelParserTypes.pas
@@ -0,0 +1,52 @@
+unit Keyman.Developer.System.LexicalModelParserTypes;
+
+interface
+
+type
+ TLexicalModelFormat = (lmfUnknown, lmfTrie10, lmfCustom10);
+ TLexicalModelWordBreaker = (lmwbUnknown, lmwbDefault, lmwbAscii, lmwbCustom);
+
+ TLexicalModelParserTypes = class sealed
+ private
+ const
+ SLexicalModelFormats: array[TLexicalModelFormat] of string = ('?', 'trie-1.0', 'custom-1.0');
+ SLexicalModelWordBreakers: array[TLexicalModelWordBreaker] of string = ('?', 'default', 'ascii', 'custom');
+ LexicalModelFormats: set of TLexicalModelFormat = [lmfUnknown..lmfCustom10];
+ LexicalModelWordBreakers: set of TLexicalModelWordBreaker = [lmwbUnknown..lmwbCustom];
+ public
+ class function FormatFromText(const Value: string): TLexicalModelFormat; static;
+ class function FormatToText(const Value: TLexicalModelFormat): string; static;
+ class function WordBreakerFromText(const Value: string): TLexicalModelWordBreaker; static;
+ class function WordBreakerToText(const Value: TLexicalModelWordBreaker): string; static;
+ end;
+
+implementation
+
+uses
+ System.SysUtils;
+
+class function TLexicalModelParserTypes.FormatFromText(const Value: string): TLexicalModelFormat;
+begin
+ for Result in LexicalModelFormats do
+ if SLexicalModelFormats[Result].Equals(Value) then Exit;
+ Result := lmfUnknown;
+end;
+
+class function TLexicalModelParserTypes.FormatToText(const Value: TLexicalModelFormat): string;
+begin
+ Result := SLexicalModelFormats[Value];
+end;
+
+class function TLexicalModelParserTypes.WordBreakerFromText(const Value: string): TLexicalModelWordBreaker;
+begin
+ for Result in LexicalModelWordBreakers do
+ if SLexicalModelWordBreakers[Result].Equals(Value) then Exit;
+ Result := lmwbUnknown;
+end;
+
+class function TLexicalModelParserTypes.WordBreakerToText(const Value: TLexicalModelWordBreaker): string;
+begin
+ Result := SLexicalModelWordBreakers[Value];
+end;
+
+end.
diff --git a/windows/src/developer/TIKE/main/UframeTextEditor.pas b/windows/src/developer/TIKE/main/UframeTextEditor.pas
index fca4d88760..e4b5b1dc8d 100644
--- a/windows/src/developer/TIKE/main/UframeTextEditor.pas
+++ b/windows/src/developer/TIKE/main/UframeTextEditor.pas
@@ -1116,7 +1116,15 @@ begin
try
j.AddPair('x', TJSONNumber.Create(X));
j.AddPair('y', TJSONNumber.Create(Y));
- j.AddPair('text', cdo.Text[cdo.InsertType]);
+
+ // The character map insert format actually only
+ // makes sense for the .kmn source editor. For all
+ // other contexts, we currently only support cmimCharacter.
+ // It would be possible to do \uxxxx for JS/JSON etc but
+ // for now that is low priority.
+ if FEditorFormat = efKMN
+ then j.AddPair('text', cdo.Text[cdo.InsertType])
+ else j.AddPair('text', cdo.Text[cmimCharacter]);
ExecuteCommand('charmapDragDrop', j);
finally
j.Free;
diff --git a/windows/src/developer/TIKE/main/UfrmMain.dfm b/windows/src/developer/TIKE/main/UfrmMain.dfm
index 80a7409c84..fb3c8d4764 100644
--- a/windows/src/developer/TIKE/main/UfrmMain.dfm
+++ b/windows/src/developer/TIKE/main/UfrmMain.dfm
@@ -2950,7 +2950,19 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper
Action = modActionsMain.actProjectSettings
end
end
- object Keyboards1: TMenuItem
+ object mnuModel: TMenuItem
+ Caption = '&Model'
+ object CompileModel1: TMenuItem
+ Action = modActionsModelEditor.actModelCompile
+ end
+ object N2: TMenuItem
+ Caption = '-'
+ end
+ object estLexicalModel1: TMenuItem
+ Action = modActionsModelEditor.actModelTest
+ end
+ end
+ object mnuKeyboard: TMenuItem
Caption = '&Keyboard'
object CompileKeyboard1: TMenuItem
Action = modActionsKeyboardEditor.actKeyboardCompile
@@ -2989,7 +3001,7 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper
Action = modActionsKeyboardEditor.actKeyboardFontHelper
end
end
- object Debug2: TMenuItem
+ object mnuDebug: TMenuItem
Caption = '&Debug'
object SetBreakpoint1: TMenuItem
Action = modActionsKeyboardEditor.actDebugSetClearBreakpoint
diff --git a/windows/src/developer/TIKE/main/UfrmMain.pas b/windows/src/developer/TIKE/main/UfrmMain.pas
index 8cc494d7ec..03d3021ec0 100644
--- a/windows/src/developer/TIKE/main/UfrmMain.pas
+++ b/windows/src/developer/TIKE/main/UfrmMain.pas
@@ -97,6 +97,7 @@ uses
mrulist,
UfrmUnicodeDataStatus,
CharacterDragObject,
+ Keyman.Developer.UI.dmActionsModelEditor,
dmActionsMain, UnicodeData, UserMessages, webhelp,
dmActionsKeyboardEditor, Dialogs, UfrmTike, AppEvnts,
DropTarget,
@@ -156,8 +157,8 @@ type
Edit1: TMenuItem;
View1: TMenuItem;
Project1: TMenuItem;
- Keyboards1: TMenuItem;
- Debug2: TMenuItem;
+ mnuKeyboard: TMenuItem;
+ mnuDebug: TMenuItem;
ools1: TMenuItem;
Help1: TMenuItem;
New1: TMenuItem;
@@ -269,6 +270,10 @@ type
DebugTests1: TMenuItem;
CrashTest1: TMenuItem;
CloseProject1: TMenuItem;
+ mnuModel: TMenuItem;
+ CompileModel1: TMenuItem;
+ N2: TMenuItem;
+ estLexicalModel1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mnuFileClick(Sender: TObject);
@@ -341,6 +346,7 @@ type
procedure SaveDockLayout;
procedure CEFShutdownComplete(Sender: TObject);
procedure ActivateActiveChild;
+ function OpenModelEditor(FFileName: string): TfrmTikeEditor;
protected
procedure WndProc(var Message: TMessage); override;
@@ -432,6 +438,7 @@ uses
Keyman.Developer.UI.Project.ProjectFileUI,
Keyman.Developer.UI.Project.ProjectUI,
Keyman.Developer.UI.UfrmWordlistEditor,
+ Keyman.Developer.UI.UfrmModelEditor,
TextFileFormat,
RedistFiles,
ErrorControlledRegistry,
@@ -479,6 +486,7 @@ begin
modActionsTextEditor := TmodActionsTextEditor.Create(Self);
modActionsKeyboardEditor := TmodActionsKeyboardEditor.Create(Self);
modActionsMain := TmodActionsMain.Create(Self);
+ modActionsModelEditor := TmodActionsModelEditor.Create(Self);
FProjectMRU := TMRUList.Create('Project');
FProjectMRU.OnChange := ProjectMRUChange;
@@ -1104,6 +1112,11 @@ begin
end;
function TfrmKeymanDeveloper.OpenFile(FFileName: string; FCloseNewFile: Boolean): TfrmTikeChild;
+ function FileHasModelTsExt(Filename: string): Boolean;
+ begin
+ // We cannot use ExtractFileExt because of the two-part extension
+ Result := Filename.ToLower.EndsWith('.model.ts');
+ end;
var
ext: string;
begin
@@ -1137,6 +1150,7 @@ begin
else if ext = '.kvks' then Result := OpenKVKEditor(FFileName)
else if ext = '.bmp' then Result := OpenEditor(FFileName, TfrmBitmapEditor)
else if ext = '.tsv' then Result := OpenTSVEditor(FFileName)
+ else if FileHasModelTsExt(FFileName) then Result := OpenModelEditor(FFileName)
else Result := OpenEditor(FFileName, TfrmEditor);
end;
@@ -1166,6 +1180,11 @@ begin
//else Result := OpenEditor(FFileName, TfrmEditor);
end;
+function TfrmKeymanDeveloper.OpenModelEditor(FFileName: string): TfrmTikeEditor;
+begin
+ Result := OpenEditor(FFileName, TfrmModelEditor);
+end;
+
function TfrmKeymanDeveloper.OpenKPSEditor(FFileName: string): TfrmTikeEditor;
begin
Result := OpenEditor(FFileName, TfrmPackageEditor);
@@ -1414,6 +1433,9 @@ begin
if PrevFocus.Visible then
PrevFocus.SetFocus;
end;
+
+ modActionsKeyboardEditor.actKeyboardCompile.Update;
+ modActionsModelEditor.actModelCompile.Update;
end;
procedure TfrmKeymanDeveloper.UDUI_Error(Sender: TUnicodeData;
diff --git a/windows/src/developer/TIKE/oskbuilder/UframeTouchLayoutBuilder.pas b/windows/src/developer/TIKE/oskbuilder/UframeTouchLayoutBuilder.pas
index 8d93a2564b..8c56439806 100644
--- a/windows/src/developer/TIKE/oskbuilder/UframeTouchLayoutBuilder.pas
+++ b/windows/src/developer/TIKE/oskbuilder/UframeTouchLayoutBuilder.pas
@@ -677,7 +677,7 @@ begin
try
j.AddPair('x', TJSONNumber.Create(X));
j.AddPair('y', TJSONNumber.Create(Y));
- j.AddPair('text', cdo.Text[cdo.InsertType]);
+ j.AddPair('text', cdo.Text[cmimCharacter]); // It never makes sense to drop anything other than char
BuilderCommand('charmapDragDrop', j);
finally
j.Free;
diff --git a/windows/src/developer/TIKE/project/Keyman.Developer.System.Project.modelTsProjectFile.pas b/windows/src/developer/TIKE/project/Keyman.Developer.System.Project.modelTsProjectFile.pas
index fc011d57a0..822f920ee6 100644
--- a/windows/src/developer/TIKE/project/Keyman.Developer.System.Project.modelTsProjectFile.pas
+++ b/windows/src/developer/TIKE/project/Keyman.Developer.System.Project.modelTsProjectFile.pas
@@ -34,7 +34,8 @@ type
TmodelTsProjectFile = class(TOpenableProjectFile)
private
FDebug: Boolean;
- FWarnAsError: Boolean; // I4706
+ FWarnAsError: Boolean;
+ FTestKeyboard: string; // I4706
function GetTargetFilename: string;
protected
@@ -49,10 +50,10 @@ type
procedure SaveState(node: IXMLNode); override; // I4698
property Debug: Boolean read FDebug write FDebug;
+ property TestKeyboard: string read FTestKeyboard write FTestKeyboard;
property WarnAsError: Boolean read FWarnAsError write FWarnAsError; // I4706
-// property OutputFilename: string read GetOutputFilename;
property TargetFilename: string read GetTargetFilename;
end;
@@ -80,6 +81,7 @@ procedure TmodelTsProjectFile.SaveState(node: IXMLNode); // I4698
begin
inherited SaveState(node);
node.AddChild('Debug').NodeValue := FDebug;
+ node.AddChild('TestKeyboard').NodeValue := FTestKeyboard;
end;
procedure TmodelTsProjectFile.Load(node: IXMLNode; LoadState: Boolean); // I4698
@@ -95,8 +97,12 @@ begin
inherited LoadState(node);
try
if node.ChildNodes.IndexOf('Debug') >= 0 then FDebug := node.ChildValues['Debug'];
+ if node.ChildNodes.IndexOf('TestKeyboard') >= 0
+ then FTestKeyboard := node.ChildValues['TestKeyboard']
+ else FTestKeyboard := '';
except
FDebug := False;
+ FTestKeyboard := '';
end;
end;
diff --git a/windows/src/developer/TIKE/project/Keyman.Developer.UI.Project.modelTsProjectFileUI.pas b/windows/src/developer/TIKE/project/Keyman.Developer.UI.Project.modelTsProjectFileUI.pas
index b288af843e..937ed59e42 100644
--- a/windows/src/developer/TIKE/project/Keyman.Developer.UI.Project.modelTsProjectFileUI.pas
+++ b/windows/src/developer/TIKE/project/Keyman.Developer.UI.Project.modelTsProjectFileUI.pas
@@ -37,6 +37,8 @@ type
function GetDebug: Boolean;
procedure SetDebug(const Value: Boolean);
function CompileModel(FSilent: Boolean): Boolean;
+ function TestKeymanWeb(FSilent: Boolean): Boolean;
+ function TestModelState(FCompiledName: string; FSilent: Boolean): Boolean;
public
function DoAction(action: TProjectFileAction; FSilent: Boolean): Boolean; override;
property Debug: Boolean read GetDebug write SetDebug;
@@ -51,10 +53,13 @@ uses
Vcl.Dialogs,
Vcl.Graphics,
Vcl.Controls,
+
dmActionsMain,
+ KeyboardFonts,
+ UmodWebHttpServer,
UfrmMain,
UfrmMDIEditor,
- KeyboardFonts,
+ Keyman.Developer.UI.UfrmModelEditor,
KeymanDeveloperUtils,
KeymanDeveloperOptions,
System.Classes,
@@ -64,8 +69,9 @@ uses
function TmodelTsProjectFileUI.DoAction(action: TProjectFileAction; FSilent: Boolean): Boolean;
begin
case action of
- pfaCompile: Result := CompileModel(FSilent);
- pfaClean: Result := ProjectFile.Clean;
+ pfaCompile: Result := CompileModel(FSilent);
+ pfaClean: Result := ProjectFile.Clean;
+ pfaTestKeymanWeb: Result := TestKeymanWeb(FSilent);
else
Result := False;
end;
@@ -108,6 +114,73 @@ begin
ProjectFile.Debug := Value;
end;
+function TmodelTsProjectFileUI.TestKeymanWeb(FSilent: Boolean): Boolean;
+var
+ FCompiledName: string;
+ editor: TfrmTikeEditor;
+ wizard: TfrmModelEditor;
+ FontNames: TKeyboardFontArray;
+ i: TKeyboardFont;
+begin
+ editor := frmKeymanDeveloper.FindEditorByFileName(ProjectFile.FileName); // I4021
+ if not Assigned(editor) or not (editor is TfrmModelEditor) then
+ Exit(False);
+ wizard := editor as TfrmModelEditor;
+
+ FCompiledName := ProjectFile.TargetFilename;
+ if not TestModelState(FCompiledName, FSilent) then
+ Exit(False);
+
+ for i := Low(TKeyboardFont) to High(TKeyboardFont) do
+ FontNames[i] := '';
+
+ if FileExists(ProjectFile.TestKeyboard) then
+ modWebHttpServer.Debugger.RegisterKeyboard(ProjectFile.TestKeyboard, '1.0', FontNames);
+ modWebHttpServer.Debugger.RegisterModel(FCompiledName);
+
+ wizard.NotifyStartedWebDebug; // I4021
+
+ Result := True;
+end;
+
+function TmodelTsProjectFileUI.TestModelState(FCompiledName: string;
+ FSilent: Boolean): Boolean;
+var
+ ftts, ftjs: TDateTime;
+begin
+ Result := False;
+
+ if not FileExists(FCompiledName) then
+ if FSilent then
+ begin
+ if not CompileModel(FSilent) then Exit;
+ end
+ else
+ case MessageDlg('You need to compile the model before you can continue. Compile now?',
+ mtConfirmation, mbOkCancel, 0) of
+ mrOk: if not CompileModel(FSilent) then Exit;
+ mrCancel: Exit;
+ end;
+
+ FileAge(ProjectFile.FileName, ftts);
+ FileAge(FCompiledName, ftjs);
+
+ if ProjectFile.Modified or (ftts > ftjs) then
+ if FSilent then
+ begin
+ if not CompileModel(FSilent) then Exit;
+ end
+ else
+ case MessageDlg('The source file has changed. Recompile before continuing?',
+ mtConfirmation, mbYesNoCancel, 0) of
+ mrYes: if not CompileModel(FSilent) then Exit;
+ mrNo: ;
+ mrCancel: Exit;
+ end;
+
+ Result := True;
+end;
+
initialization
RegisterProjectFileUIType(TmodelTsProjectFileAction, TmodelTsProjectFileUI);
end.
diff --git a/windows/src/developer/TIKE/xml/kmw/index.html b/windows/src/developer/TIKE/xml/kmw/index.html
index ec5007592b..7d48be0920 100644
--- a/windows/src/developer/TIKE/xml/kmw/index.html
+++ b/windows/src/developer/TIKE/xml/kmw/index.html
@@ -59,6 +59,7 @@
.touch-device #install-link,
.touch-device #install-link-packages,
+ .touch-device #model-link,
.touch-device-ios #install-link-ios,
.touch-device-android #install-link-android {
display: inline-block;
@@ -132,10 +133,6 @@
-
-
-
-
@@ -156,7 +153,15 @@
@@ -322,7 +327,62 @@
//document.getElementById('ta1').focus();
keyman.moveToElement('ta1');
}, 10);
+
+ document.getElementById('model-link').addEventListener('click', modelLinkClick);
}
+
+ /* Lexical models */
+
+ var firstModel = true;
+
+ /**
+ * Register a model for debugging. Called by keyboards.js. The
+ * first model registered will be activated automatically.
+ */
+ function registerModel(model, src) {
+ var list = document.getElementById('model-list-inner');
+ var a = document.createElement('a');
+ a.href = '#';
+ a.innerText = model;
+ a.addEventListener('click', function(ev) {
+ ev.returnValue = false;
+
+ var lastModel = keyman.modelManager.activeModel;
+ if(lastModel)
+ keyman.modelManager.deregister(lastModel.id);
+ keyman.modelManager.register({
+ id: model,
+ languages: ['en'],
+ path: 'http://'+location.host+'/model/'+src
+ });
+ });
+ list.appendChild(a);
+
+ if(firstModel) {
+ keyman.modelManager.register({
+ id: model,
+ languages: ['en'],
+ path: 'http://'+location.host+'/model/'+src
+ });
+ document.getElementById('model-list-empty').style.display = 'none';
+ firstModel = false;
+ }
+ }
+
+ /**
+ * Toggle visibility of the model menu
+ */
+ function modelLinkClick(e) {
+ var elem = document.getElementById('model-list');
+ elem.className = elem.className == '' ? 'model-list-visible' : '';
+ e.returnValue = false;
+ return false;
+ }
+
+
+
+
+