From bb0aaedb73f9db782c3ef28b06f0b750affb8b07 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 9 Jul 2018 21:07:42 +0700 Subject: [PATCH] [developer] Refactor of project delivery via internal web server instead of file system --- ...Keyman.Developer.System.HttpServer.App.pas | 120 +++++++++++++++- windows/src/developer/TIKE/Tike.dpr | 3 +- windows/src/developer/TIKE/Tike.dproj | 1 + .../developer/TIKE/actions/dmActionsMain.dfm | 4 +- .../developer/TIKE/actions/dmActionsMain.pas | 15 +- .../TIKE/child/UfrmPackageEditor.dfm | 13 +- .../TIKE/child/UfrmPackageEditor.pas | 2 +- ...eyman.Developer.System.HttpServer.Base.pas | 58 ++++++++ ...n.Developer.System.HttpServer.Debugger.pas | 30 ++-- windows/src/developer/TIKE/main/UfrmMain.dfm | 4 +- windows/src/developer/TIKE/main/UfrmMain.pas | 5 +- .../developer/TIKE/project/ProjectFile.pas | 90 +++++++++++- .../TIKE/project/ProjectFileType.pas | 18 +-- .../developer/TIKE/project/ProjectLoader.pas | 4 +- .../src/developer/TIKE/project/ProjectUI.pas | 16 +++ .../developer/TIKE/project/UfrmProject.pas | 18 +-- .../developer/TIKE/project/kmnProjectFile.pas | 2 +- .../developer/TIKE/project/kpsProjectFile.pas | 2 +- .../developer/TIKE/web/UmodWebHttpServer.pas | 29 ++-- .../TIKE/xml/project/distribution.xsl | 4 +- .../developer/TIKE/xml/project/elements.xsl | 18 +-- .../developer/TIKE/xml/project/keyboards.xsl | 128 ++++++++++++------ .../developer/TIKE/xml/project/packages.xsl | 4 +- .../developer/TIKE/xml/project/project.xsl | 16 +-- .../developer/TIKE/xml/project/welcome.xsl | 4 +- 25 files changed, 458 insertions(+), 150 deletions(-) create mode 100644 windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Base.pas diff --git a/windows/src/developer/TIKE/Keyman.Developer.System.HttpServer.App.pas b/windows/src/developer/TIKE/Keyman.Developer.System.HttpServer.App.pas index 9b7a49d660..1439749220 100644 --- a/windows/src/developer/TIKE/Keyman.Developer.System.HttpServer.App.pas +++ b/windows/src/developer/TIKE/Keyman.Developer.System.HttpServer.App.pas @@ -5,10 +5,15 @@ interface uses IdContext, IdCustomHTTPServer, - IdHTTPServer; + IdHTTPServer, + + Keyman.Developer.System.HttpServer.Base; type - TAppHttpServer = class + TAppHttpResponder = class(TBaseHttpResponder) + private + procedure RespondProject(doc: string; AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); public procedure ProcessRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); @@ -16,12 +21,119 @@ type implementation +uses + System.SysUtils, + + ProjectFile; + { TAppHttpServer } -procedure TAppHttpServer.ProcessRequest(AContext: TIdContext; +procedure TAppHttpResponder.RespondProject(doc: string; AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); -begin + procedure RespondProjectFile; + var + path: string; + begin + if ARequestInfo.Params.IndexOfName('path') < 0 then + begin + AResponseInfo.ResponseNo := 400; + AResponseInfo.ResponseText := 'Missing parameter path'; + Exit; + end; + + path := ARequestInfo.Params.Values['path']; + + if not FileExists(path) or not SameText(ExtractFileExt(path), '.kpj') then + begin + AResponseInfo.ResponseNo := 400; + AResponseInfo.ResponseText := 'Project file '+path+' does not exist.'; + Exit; + end; + + // Transform the .kpj + with TProject.Create(path) do + try + AResponseInfo.ContentType := 'text/html; charset=UTF-8'; + AResponseInfo.ContentText := Render; + finally + Free; + end; + end; + + procedure RespondIco; + var + path: string; + begin + if ARequestInfo.Params.IndexOfName('path') < 0 then + begin + AResponseInfo.ResponseNo := 400; + AResponseInfo.ResponseText := 'Missing parameter path'; + Exit; + end; + + path := ARequestInfo.Params.Values['path']; + + if not FileExists(path) or ( + not SameText(ExtractFileExt(path), '.ico') and + not SameText(ExtractFileExt(path), '.bmp') + ) then + begin + AResponseInfo.ResponseNo := 400; + AResponseInfo.ResponseText := 'Image file '+path+' does not exist.'; + Exit; + end; + + RespondFile(path, AContext, ARequestInfo, AResponseInfo); + end; + + procedure RespondResource; + begin + Delete(doc, 1, 4); + if (Pos('/', doc) > 0) or (Pos('\', doc) > 0) then + Respond404(AContext, ARequestInfo, AResponseInfo); + RespondFile(TProject.StandardTemplatePath + '/' + doc, AContext, ARequestInfo, AResponseInfo); + end; +begin + // + // http://localhost:8008/app/project/(index)?path= + // http://localhost:8008/app/project/ + // + Delete(doc, 1, 8); + if (doc = '') or (doc = 'index') then + RespondProjectFile + else if doc = 'ico' then + RespondIco + else if Copy(doc, 1, 4) = 'res/' then + RespondResource; +end; + +procedure TAppHttpResponder.ProcessRequest(AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); +var + doc: string; +begin + // We know the request starts with /app/ + doc := ARequestInfo.Document; + Delete(doc, 1, 5); // /app/ + + // App requests are only accepted from local computer + // So test that the request comes from localhost + if (AContext.Binding.PeerIP <> '127.0.0.1') and + (AContext.Binding.PeerIP <> '0:0:0:0:0:0:0:1') then + begin + AResponseInfo.ResponseNo := 403; + AResponseInfo.ResponseText := 'Access denied'; + Exit; + end; + + if Copy(doc, 1, 8) = 'project/' then + begin + RespondProject(doc, AContext, ARequestInfo, AResponseInfo); + Exit; + end; + + Respond404(AContext, ARequestInfo, AResponseInfo); end; end. diff --git a/windows/src/developer/TIKE/Tike.dpr b/windows/src/developer/TIKE/Tike.dpr index 39ed7693f1..156e206782 100644 --- a/windows/src/developer/TIKE/Tike.dpr +++ b/windows/src/developer/TIKE/Tike.dpr @@ -271,7 +271,8 @@ uses Keyman.System.CanonicalLanguageCodeUtils in '..\..\global\delphi\general\Keyman.System.CanonicalLanguageCodeUtils.pas', Keyman.Developer.System.InitializeCEF in 'main\Keyman.Developer.System.InitializeCEF.pas', Keyman.Developer.System.HttpServer.Debugger in 'http\Keyman.Developer.System.HttpServer.Debugger.pas', - Keyman.Developer.System.HttpServer.App in 'Keyman.Developer.System.HttpServer.App.pas'; + Keyman.Developer.System.HttpServer.App in 'Keyman.Developer.System.HttpServer.App.pas', + Keyman.Developer.System.HttpServer.Base in 'http\Keyman.Developer.System.HttpServer.Base.pas'; {$R *.RES} {$R ICONS.RES} diff --git a/windows/src/developer/TIKE/Tike.dproj b/windows/src/developer/TIKE/Tike.dproj index 59244e0e9d..02060583cb 100644 --- a/windows/src/developer/TIKE/Tike.dproj +++ b/windows/src/developer/TIKE/Tike.dproj @@ -511,6 +511,7 @@ + Cfg_2 diff --git a/windows/src/developer/TIKE/actions/dmActionsMain.dfm b/windows/src/developer/TIKE/actions/dmActionsMain.dfm index 8b75fea8c4..62fbe341d3 100644 --- a/windows/src/developer/TIKE/actions/dmActionsMain.dfm +++ b/windows/src/developer/TIKE/actions/dmActionsMain.dfm @@ -482,7 +482,7 @@ object modActionsMain: TmodActionsMain Left = 304 Top = 236 Bitmap = { - 494C01010A000E00680010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01010A000E006C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000003000000001002000000000000030 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -891,7 +891,7 @@ object modActionsMain: TmodActionsMain Left = 124 Top = 116 Bitmap = { - 494C0101110013007C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010111001300800020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000080000000A000000001002000000000000040 0100000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000A8CAFF00A8CA diff --git a/windows/src/developer/TIKE/actions/dmActionsMain.pas b/windows/src/developer/TIKE/actions/dmActionsMain.pas index 428fe5f8ea..ceb978c9df 100644 --- a/windows/src/developer/TIKE/actions/dmActionsMain.pas +++ b/windows/src/developer/TIKE/actions/dmActionsMain.pas @@ -228,6 +228,7 @@ uses ProjectFile, ProjectFileType, ProjectFileUI, + ProjectUI, GlobalProxySettings, RegistryKeys, TextFileFormat, @@ -276,7 +277,7 @@ begin if FileName <> '' then begin if AddToProject then - FEditor.ProjectFile := CreateProjectFile(FileName, nil); + FEditor.ProjectFile := CreateProjectFile(FGlobalProject, FileName, nil); FEditor.OpenFile(FileName); end; end; @@ -450,7 +451,7 @@ begin begin if not Assigned(ActiveEditor) or ActiveEditor.Untitled then Exit; if FGlobalProject.Files.IndexOfFileName(ActiveEditor.FileName) >= 0 then Exit; - ActiveEditor.ProjectFile := CreateProjectFile(ActiveEditor.FileName, nil); + ActiveEditor.ProjectFile := CreateProjectFile(FGlobalProject, ActiveEditor.FileName, nil); ShowProject; end; end; @@ -470,7 +471,7 @@ var begin for i := 0 to actProjectAddFiles.Dialog.Files.Count - 1 do if FGlobalProject.Files.IndexOfFileName(actProjectAddFiles.Dialog.Files[i]) < 0 then - CreateProjectFile(actProjectAddFiles.Dialog.Files[i], nil); + CreateProjectFile(FGlobalProject, actProjectAddFiles.Dialog.Files[i], nil); frmKeymanDeveloper.ShowProject; end; @@ -480,8 +481,8 @@ begin begin FGlobalProject.Save; ProjectForm.Free; - FreeAndNil(FGlobalProject); - FGlobalProject := TProjectUI.Create(''); // I4687 + FreeGlobalProjectUI; + LoadGlobalProjectUI(''); ShowProject; end; end; @@ -500,8 +501,8 @@ begin end; FGlobalProject.Save; - FreeAndNil(FGlobalProject); - FGlobalProject := TProjectUI.Create(FileName); // I4687 + FreeGlobalProjectUI; + LoadGlobalProjectUI(FileName); // I4687 frmKeymanDeveloper.ProjectMRU.Add(FGlobalProject.FileName); frmKeymanDeveloper.ShowProject; end; diff --git a/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm b/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm index 6cb2fa7a7e..1e9957e868 100644 --- a/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm +++ b/windows/src/developer/TIKE/child/UfrmPackageEditor.dfm @@ -193,11 +193,10 @@ inherited frmPackageEditor: TfrmPackageEditor TabWidth = 60 OnChange = pagesChange OnChanging = pagesChanging - ExplicitWidth = 681 - ExplicitHeight = 447 object pageFiles: TTabSheet Caption = 'Files' ImageIndex = 3 + ExplicitLeft = 0 ExplicitWidth = 588 ExplicitHeight = 447 object Panel1: TPanel @@ -280,7 +279,6 @@ inherited frmPackageEditor: TfrmPackageEditor ItemHeight = 13 TabOrder = 0 OnClick = lbFilesClick - ExplicitHeight = 329 end object cmdAddFile: TButton Left = 14 @@ -364,6 +362,7 @@ inherited frmPackageEditor: TfrmPackageEditor object pageKeyboards: TTabSheet Caption = 'Keyboards' ImageIndex = 5 + ExplicitLeft = 0 ExplicitWidth = 588 ExplicitHeight = 447 object Panel5: TPanel @@ -469,7 +468,6 @@ inherited frmPackageEditor: TfrmPackageEditor ItemHeight = 13 TabOrder = 0 OnClick = lbKeyboardsClick - ExplicitHeight = 233 end object editKeyboardDescription: TEdit Left = 96 @@ -593,6 +591,7 @@ inherited frmPackageEditor: TfrmPackageEditor object pageDetails: TTabSheet Caption = 'Details' ImageIndex = 2 + ExplicitLeft = 0 ExplicitWidth = 588 ExplicitHeight = 447 object Panel2: TPanel @@ -732,7 +731,6 @@ inherited frmPackageEditor: TfrmPackageEditor Anchors = [akLeft, akTop, akRight] TabOrder = 0 OnClick = cbReadMeClick - ExplicitWidth = 215 end object editInfoName: TEdit Left = 108 @@ -815,7 +813,6 @@ inherited frmPackageEditor: TfrmPackageEditor Anchors = [akLeft, akTop, akRight] TabOrder = 9 OnClick = cbKMPImageFileClick - ExplicitWidth = 215 end object panKMPImageSample: TPanel Left = 694 @@ -847,6 +844,7 @@ inherited frmPackageEditor: TfrmPackageEditor object pageShortcuts: TTabSheet Caption = 'Shortcuts' ImageIndex = 8 + ExplicitLeft = 0 ExplicitWidth = 588 ExplicitHeight = 447 object Panel3: TPanel @@ -963,7 +961,6 @@ inherited frmPackageEditor: TfrmPackageEditor ItemHeight = 13 TabOrder = 3 OnClick = lbStartMenuEntriesClick - ExplicitHeight = 254 end object cmdNewStartMenuEntry: TButton Left = 14 @@ -1017,12 +1014,14 @@ inherited frmPackageEditor: TfrmPackageEditor object pageSource: TTabSheet Caption = 'Source' ImageIndex = 9 + ExplicitLeft = 0 ExplicitWidth = 588 ExplicitHeight = 447 end object pageCompile: TTabSheet Caption = 'Compile' ImageIndex = 1 + ExplicitLeft = 0 ExplicitWidth = 588 ExplicitHeight = 447 object Panel4: TPanel diff --git a/windows/src/developer/TIKE/child/UfrmPackageEditor.pas b/windows/src/developer/TIKE/child/UfrmPackageEditor.pas index fa0dd67c39..ed7d236a29 100644 --- a/windows/src/developer/TIKE/child/UfrmPackageEditor.pas +++ b/windows/src/developer/TIKE/child/UfrmPackageEditor.pas @@ -1004,7 +1004,7 @@ begin end else begin - f := CreateProjectFile(s, ProjectFile); + f := CreateProjectFile(FGlobalProject, s, ProjectFile); try fui := f.UI as TProjectFileUI; fui.DefaultEvent(Self); diff --git a/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Base.pas b/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Base.pas new file mode 100644 index 0000000000..45d4699492 --- /dev/null +++ b/windows/src/developer/TIKE/http/Keyman.Developer.System.HttpServer.Base.pas @@ -0,0 +1,58 @@ +unit Keyman.Developer.System.HttpServer.Base; + +interface + +uses + IdContext, + IdCustomHTTPServer, + IdHTTPServer; + +type + TBaseHttpResponder = class + protected + procedure RespondFile(const AFileName: string; AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); + procedure Respond404(AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); + end; + +implementation + +uses + IdGlobalProtocols, + + System.SysUtils; + +{ TBaseHttpResponder } + +procedure TBaseHttpResponder.Respond404( + AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; + AResponseInfo: TIdHTTPResponseInfo); +begin + AResponseInfo.ResponseNo := 404; + AResponseInfo.ResponseText := 'File not found'; +end; + +procedure TBaseHttpResponder.RespondFile(const AFileName: string; + AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; + AResponseInfo: TIdHTTPResponseInfo); +begin + // Serve the file + + if not FileExists(AFileName) then + begin + AResponseInfo.ResponseNo := 404; + AResponseInfo.ResponseText := 'File not found'; + Exit; + end; + + AResponseInfo.ContentType := AResponseInfo.HTTPServer.MIMETable.GetFileMIMEType(AFileName); + AResponseInfo.CharSet := 'UTF-8'; + AResponseInfo.ContentLength := FileSizeByName(AFileName); +//AResponseInfo.LastModified := GetFileDate(doc); + AResponseInfo.WriteHeader; + + AContext.Connection.IOHandler.WriteFile(AFileName); +end; + +end. 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 c21e563d80..27d36a816c 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 @@ -12,6 +12,8 @@ uses IdCustomHTTPServer, IdHTTPServer, + Keyman.Developer.System.HttpServer.Base, + KeyboardFonts; type @@ -52,7 +54,7 @@ type property Name: string read FName; end; - TDebuggerHttpServer = class + TDebuggerHttpResponder = class(TBaseHttpResponder) private FKeyboardsCS, FPackagesCS: TCriticalSection; // I4036 FKeyboards: TObjectDictionary; // I4063 @@ -105,7 +107,7 @@ end; { TDebuggerHttpServer } -constructor TDebuggerHttpServer.Create; +constructor TDebuggerHttpResponder.Create; begin FKeyboardsCS := TCriticalSection.Create; // I4036 FKeyboards := TObjectDictionary.Create; // I4063 @@ -114,7 +116,7 @@ begin FPackages := TObjectDictionary.Create; // I4063 end; -destructor TDebuggerHttpServer.Destroy; +destructor TDebuggerHttpResponder.Destroy; begin FreeAndNil(FKeyboards); FreeAndNil(FKeyboardsCS); // I4036 @@ -125,7 +127,7 @@ begin inherited Destroy; end; -function TDebuggerHttpServer.GetKeyboardStoredFileName( +function TDebuggerHttpResponder.GetKeyboardStoredFileName( const WebFilename: string): string; begin FKeyboardsCS.Enter; // I4036 @@ -137,7 +139,7 @@ begin end; end; -function TDebuggerHttpServer.GetPackageStoredFileName( +function TDebuggerHttpResponder.GetPackageStoredFileName( const WebFilename: string): string; begin FPackagesCS.Enter; // I4036 @@ -149,7 +151,7 @@ begin end; end; -procedure TDebuggerHttpServer.ProcessRequest(AContext: TIdContext; +procedure TDebuggerHttpResponder.ProcessRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); procedure Respond404; @@ -491,18 +493,14 @@ var FFileRegExp: TRegExpr; FResourceFileRegExp: TRegExpr; begin + // /keyboard/###.js -> looks up the list of currently testing keyboards + // everything else retrieved from xml/kmw/ doc := ARequestInfo.Document; Delete(doc, 1, 1); if doc = '' then doc := 'index.html'; - if Copy(doc, 1, 8) = 'project/' then - begin - RespondProject; - Exit; - end; - if doc = 'inc/keyboards.js' then begin RespondKeyboardsJS; @@ -639,7 +637,7 @@ begin end; end; -procedure TDebuggerHttpServer.RegisterKeyboard(const Filename, Version: string; FontInfo: TKeyboardFontArray); // I4063 // I4409 +procedure TDebuggerHttpResponder.RegisterKeyboard(const Filename, Version: string; FontInfo: TKeyboardFontArray); // I4063 // I4409 var k: TWebDebugKeyboardInfo; begin @@ -652,7 +650,7 @@ begin end; end; -procedure TDebuggerHttpServer.RegisterPackage(const Filename, Name: string); +procedure TDebuggerHttpResponder.RegisterPackage(const Filename, Name: string); var p: TWebDebugPackageInfo; begin @@ -665,7 +663,7 @@ begin end; end; -procedure TDebuggerHttpServer.UnregisterKeyboard(const Filename: string); +procedure TDebuggerHttpResponder.UnregisterKeyboard(const Filename: string); begin FKeyboardsCS.Enter; // I4036 try @@ -675,7 +673,7 @@ begin end; end; -procedure TDebuggerHttpServer.UnregisterPackage(const Filename: string); +procedure TDebuggerHttpResponder.UnregisterPackage(const Filename: string); begin FPackagesCS.Enter; // I4036 try diff --git a/windows/src/developer/TIKE/main/UfrmMain.dfm b/windows/src/developer/TIKE/main/UfrmMain.dfm index a1eb8350d0..094f467387 100644 --- a/windows/src/developer/TIKE/main/UfrmMain.dfm +++ b/windows/src/developer/TIKE/main/UfrmMain.dfm @@ -301,7 +301,7 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper Left = 304 Top = 236 Bitmap = { - 494C01010A000E00F00010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01010A000E00F40010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000003000000001002000000000000030 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -710,7 +710,7 @@ inherited frmKeymanDeveloper: TfrmKeymanDeveloper Left = 236 Top = 236 Bitmap = { - 494C01013B004000F00010001000C0C0C000FF10FFFFFFFFFFFFFFFF424D3600 + 494C01013B004000F40010001000C0C0C000FF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000040000000F0000000010020000000000000F0 000000000000000000000000000000000000C0C0C000C0C0C000C0C0C000C0C0 C000C0C0C000C6C6C600F7730000CE5A0000CE5A0000F7730000C6C6C600C0C0 diff --git a/windows/src/developer/TIKE/main/UfrmMain.pas b/windows/src/developer/TIKE/main/UfrmMain.pas index ee024815b2..3e959db682 100644 --- a/windows/src/developer/TIKE/main/UfrmMain.pas +++ b/windows/src/developer/TIKE/main/UfrmMain.pas @@ -412,6 +412,7 @@ uses OnlineUpdateCheck, GlobalProxySettings, ProjectFileUI, + ProjectUI, TextFileFormat, RedistFiles, ErrorControlledRegistry, @@ -504,8 +505,8 @@ begin if (FActiveProject <> '') and not FileExists(FActiveProject) then FActiveProject := ''; - TProjectUI.Create(FActiveProject, True); // I4687 + LoadGlobalProjectUI(FActiveProject, True); InitDock; @@ -627,7 +628,7 @@ begin FreeAndNil(FCharMapSettings); Application.OnActivate := nil; - FreeAndNil(FGlobalProject); + FreeGlobalProjectUI; FreeAndNil(FChildWindows); FreeAndNil(FProjectMRU); diff --git a/windows/src/developer/TIKE/project/ProjectFile.pas b/windows/src/developer/TIKE/project/ProjectFile.pas index 38cd1bbe79..eb1afe2abb 100644 --- a/windows/src/developer/TIKE/project/ProjectFile.pas +++ b/windows/src/developer/TIKE/project/ProjectFile.pas @@ -130,7 +130,7 @@ type property State: TProjectState read FState; public - procedure Log(AState: TProjectLogState; Filename, Msg: string); virtual; abstract; // I4706 + procedure Log(AState: TProjectLogState; Filename, Msg: string); virtual; constructor Create(AFileName: string; ALoadPersistedUntitledProject: Boolean = False); virtual; destructor Destroy; override; @@ -139,6 +139,8 @@ type procedure PersistUntitledProject; + function Render: WideString; + function Load: Boolean; virtual; // I4694 function Save: Boolean; virtual; // I4694 @@ -317,6 +319,7 @@ uses UMD5Hash, Unicode, utildir, + utilhttp, utilsystem; { TProjectFileList } @@ -671,7 +674,6 @@ var begin FOptions := TProjectOptions.Create; // I4688 FState := psCreating; - FGlobalProject := Self; inherited Create; FMRU := TMRUList.Create(''); FMRU.OnChange := MRUChange; @@ -790,6 +792,11 @@ begin end; end; +procedure TProject.Log(AState: TProjectLogState; Filename, Msg: string); +begin + // Do nothing +end; + procedure TProject.PersistUntitledProject; var path: string; @@ -811,6 +818,83 @@ begin DoRefresh; end; +function TProject.Render: WideString; +var + doc, userdoc, xsl: IXMLDomDocument; + FLastDir: string; + i: Integer; + node: IXMLDOMElement; + nodes: IXMLDOMNodeList; +begin + if not FileExists(SavedFileName) then Save; + + Result := ''; + FLastDir := GetCurrentDir; + SetCurrentDir(StringsTemplatePath); + try + doc := MSXMLDOMDocumentFactory.CreateDOMDocument; + try + doc.async := False; + doc.load(SavedFileName); + + // + // Inject the user settings to the loaded file + // + + if FileExists(SavedFileName + '.user') then // I4698 + begin + userdoc := MSXMLDOMDocumentFactory.CreateDOMDocument; + try + userdoc.async := False; + userdoc.load(SavedFileName + '.user'); + for i := 0 to userdoc.documentElement.childNodes.length - 1 do + doc.documentElement.appendChild(userdoc.documentElement.childNodes.item[i].cloneNode(true)); + finally + userdoc := nil; + end; + end; + + // + // Remove existing path references from the saved .user file and append the + // correct ones for this computer + // + + // TODO: refactor with similar code in ProjectLoader.LoadUser and ProjectSaver.SaveUser + nodes := doc.documentElement.getElementsByTagName('templatepath'); + for i := 0 to nodes.length - 1 do + doc.documentElement.removeChild(nodes[i]); + + nodes := doc.documentElement.getElementsByTagName('stringspath'); + for i := 0 to nodes.length - 1 do + doc.documentElement.removeChild(nodes[i]); + + node := doc.createElement('templatepath'); + node.appendChild(doc.createTextNode(ConvertPathToFileURL(TProject.StandardTemplatePath))); + doc.documentElement.appendChild(node); + + node := doc.createElement('stringspath'); + node.appendChild(doc.createTextNode(ConvertPathToFileURL(TProject.StringsTemplatePath))); + doc.documentElement.appendChild(node); + // end TODO + + xsl := MSXMLDOMDocumentFactory.CreateDOMDocument; + try + xsl.async := False; + xsl.resolveExternals := True; + xsl.validateOnParse := False; + xsl.load(StringsTemplatePath + 'project.xsl'); + Result := doc.transformNode(xsl); + finally + xsl := nil; + end; + finally + doc := nil; + end; + finally + SetCurrentDir(FLastDir); + end; +end; + // I1010: Persist untitled project - end function TProject.LoadFromXML(FileName: string): Boolean; @@ -866,7 +950,7 @@ begin ReadSection('Files', s); for i := 0 to s.Count - 1 do - CreateProjectFile(ExpandMemberFileName(FileName, s[i]), nil); + CreateProjectFile(Self, ExpandMemberFileName(FileName, s[i]), nil); ReadSection('MRU', s); for i := 0 to s.Count - 1 do diff --git a/windows/src/developer/TIKE/project/ProjectFileType.pas b/windows/src/developer/TIKE/project/ProjectFileType.pas index 4905577d53..0b13c677b1 100644 --- a/windows/src/developer/TIKE/project/ProjectFileType.pas +++ b/windows/src/developer/TIKE/project/ProjectFileType.pas @@ -50,7 +50,7 @@ type function Add(Item: TProjectFileType): Integer; end; -function CreateProjectFile(AFileName: string; AParent: TProjectFile): TProjectFile; +function CreateProjectFile(AProject: TProject; AFileName: string; AParent: TProjectFile): TProjectFile; procedure RegisterProjectFileType(AExtension: string; AProjectFileClass: TProjectFileClass); type @@ -69,14 +69,14 @@ var FRegisteredFileTypes: TProjectFileTypeList = nil; FInit: Boolean = True; -function CreateProjectFile(AFileName: string; AParent: TProjectFile): TProjectFile; +function CreateProjectFile(AProject: TProject; AFileName: string; AParent: TProjectFile): TProjectFile; var Ext: string; ni, i: Integer; begin if not FInit then begin - Result := TShellProjectFile.Create(FGlobalProject, AFileName, AParent); + Result := TShellProjectFile.Create(AProject, AFileName, AParent); if Assigned(FDoCreateProjectFileUI) then FDoCreateProjectFileUI(Result); // I4687 Exit; @@ -86,10 +86,10 @@ begin { Do not allow top-level files to be added more than once } if not Assigned(AParent) then begin - i := FGlobalProject.Files.IndexOfFileNameAndParent(AFileName, nil); + i := AProject.Files.IndexOfFileNameAndParent(AFileName, nil); if i >= 0 then begin - Result := FGlobalProject.Files[i]; + Result := AProject.Files[i]; Exit; end; end; @@ -99,7 +99,7 @@ begin if FRegisteredFileTypes[i].Extension = '*' then ni := i else if FRegisteredFileTypes[i].Extension = Ext then begin - Result := FRegisteredFileTypes[i].ProjectFileClass.Create(FGlobalProject, AFileName, AParent); + Result := FRegisteredFileTypes[i].ProjectFileClass.Create(AProject, AFileName, AParent); if Assigned(AParent) then begin @@ -107,14 +107,14 @@ begin AParent.Project.Files.Add(Result); end else - FGlobalProject.Files.Add(Result); + AProject.Files.Add(Result); Exit; end; if ni = -1 then raise Exception.Create('Could not find appropriate TProjectFile for file '''+AFileName+'''.'); - Result := FRegisteredFileTypes[ni].ProjectFileClass.Create(FGlobalProject, AFileName, AParent); + Result := FRegisteredFileTypes[ni].ProjectFileClass.Create(AProject, AFileName, AParent); if Assigned(AParent) then begin @@ -122,7 +122,7 @@ begin AParent.Project.Files.Add(Result); end else - FGlobalProject.Files.Add(Result); + AProject.Files.Add(Result); end; procedure RegisterProjectFileType(AExtension: string; AProjectFileClass: TProjectFileClass); diff --git a/windows/src/developer/TIKE/project/ProjectLoader.pas b/windows/src/developer/TIKE/project/ProjectLoader.pas index b1a30d1f0e..58b583a4b2 100644 --- a/windows/src/developer/TIKE/project/ProjectLoader.pas +++ b/windows/src/developer/TIKE/project/ProjectLoader.pas @@ -117,7 +117,7 @@ begin if not VarIsNull(node.ChildValues['Filepath']) then begin // I1152 - Avoid crashes when .kpj file is invalid - pf := CreateProjectFile(ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), nil); + pf := CreateProjectFile(FProject, ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), nil); pf.Load(node, True); end; end; @@ -134,7 +134,7 @@ begin begin n := FProject.Files.IndexOfID(node.ChildValues['ParentFileID']); if n < 0 then Continue; - pf := CreateProjectFile(ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), FProject.Files[n]); + pf := CreateProjectFile(FProject, ExpandFileNameClean(FFileName, node.ChildValues['Filepath']), FProject.Files[n]); pf.Load(node, True); end; end; diff --git a/windows/src/developer/TIKE/project/ProjectUI.pas b/windows/src/developer/TIKE/project/ProjectUI.pas index 263eb784e9..34ab85dece 100644 --- a/windows/src/developer/TIKE/project/ProjectUI.pas +++ b/windows/src/developer/TIKE/project/ProjectUI.pas @@ -24,10 +24,14 @@ uses ProjectFileUI; function GetGlobalProjectUI: TProjectUI; +function LoadGlobalProjectUI(AFilename: string; ALoadPersistedUntitledProject: Boolean = False): TProjectUI; +procedure FreeGlobalProjectUI; implementation uses + System.SysUtils, + Project; function GetGlobalProjectUI: TProjectUI; @@ -35,4 +39,16 @@ begin Result := FGlobalProject as TProjectUI; end; +procedure FreeGlobalProjectUI; +begin + FreeAndNil(FGlobalProject); +end; + +function LoadGlobalProjectUI(AFilename: string; ALoadPersistedUntitledProject: Boolean = False): TProjectUI; +begin + Assert(not Assigned(FGlobalProject)); + Result := TProjectUI.Create(AFilename, ALoadPersistedUntitledProject); // I4687 + FGlobalProject := Result; +end; + end. diff --git a/windows/src/developer/TIKE/project/UfrmProject.pas b/windows/src/developer/TIKE/project/UfrmProject.pas index 25b702c6a4..1457462b1e 100644 --- a/windows/src/developer/TIKE/project/UfrmProject.pas +++ b/windows/src/developer/TIKE/project/UfrmProject.pas @@ -127,7 +127,7 @@ type procedure RefreshHTML(RefreshState: Boolean); procedure WMUserWebCommand(var Message: TMessage); message WM_USER_WEBCOMMAND; procedure EditFileExternal(FileName: WideString); - function DoNavigate(URL: WideString): Boolean; + function DoNavigate(URL: string): Boolean; procedure ClearMessages; procedure CreateBrowser; protected @@ -140,10 +140,12 @@ type implementation uses + System.StrUtils, Winapi.ShellApi, Keyman.Developer.System.HelpTopics, + dmActionsMain, KeymanDeveloperOptions, kmnProjectFile, @@ -165,7 +167,7 @@ uses utilexecute, utilxml, mrulist, - //UmodWebHttpServer, + UmodWebHttpServer, uCEFApplication; {$R *.DFM} @@ -257,9 +259,9 @@ begin tmrRefresh.Enabled := True else begin - GetGlobalProjectUI.Refreshing := True; // I4687 +// GetGlobalProjectUI.Refreshing := True; // I4687 if RefreshState then SaveCurrentTab; - cef.LoadURL(GetGlobalProjectUI.Render); + cef.LoadURL(modWebHttpServer.GetLocalhostURL + '/app/project/?path='+URLEncode(GetGlobalProjectUI.FileName)); end; RefreshCaption; end; @@ -399,7 +401,7 @@ begin frmMessages.Clear; end; -function TfrmProject.DoNavigate(URL: WideString): Boolean; +function TfrmProject.DoNavigate(URL: string): Boolean; var n: Integer; s, command: WideString; @@ -432,7 +434,7 @@ begin FNextCommand := LowerCase(s); PostMessage(Handle, WM_USER_WebCommand, WC_HELP, 0); end - else if Copy(URL, 1, 4) = 'http' then + else if not URL.StartsWith(modWebHttpServer.GetLocalhostURL) and (Copy(URL, 1, 4) = 'http') then begin Result := True; FNextCommand := URL; @@ -490,7 +492,7 @@ begin if ShowModal = mrOk then begin - pf := CreateProjectFile(FileName, nil); + pf := CreateProjectFile(FGlobalProject, FileName, nil); end; finally Free; @@ -507,7 +509,7 @@ begin dlgOpenFile.DefaultExt := FDefaultExtension; if dlgOpenFile.Execute then begin - CreateProjectFile(dlgOpenFile.FileName, nil); + CreateProjectFile(FGlobalProject, dlgOpenFile.FileName, nil); end; end else if (Command = 'editfile') or (Command = 'openfile') then diff --git a/windows/src/developer/TIKE/project/kmnProjectFile.pas b/windows/src/developer/TIKE/project/kmnProjectFile.pas index edaaa8cbf5..4c79ca26a4 100644 --- a/windows/src/developer/TIKE/project/kmnProjectFile.pas +++ b/windows/src/developer/TIKE/project/kmnProjectFile.pas @@ -364,7 +364,7 @@ begin if Project.Files[j].Parent = Self then Project.Files.Delete(j); - CreateProjectFile(value, Self); + CreateProjectFile(Project, value, Self); end end else diff --git a/windows/src/developer/TIKE/project/kpsProjectFile.pas b/windows/src/developer/TIKE/project/kpsProjectFile.pas index e6b48b4aa4..8519c214cd 100644 --- a/windows/src/developer/TIKE/project/kpsProjectFile.pas +++ b/windows/src/developer/TIKE/project/kpsProjectFile.pas @@ -203,7 +203,7 @@ begin pack.LoadXML; for i := 0 to pack.Files.Count - 1 do if Project.Files.IndexOfFileName(pack.Files[i].FileName) < 0 then - CreateProjectFile(pack.Files[i].FileName, Self); + CreateProjectFile(Project, pack.Files[i].FileName, Self); FHeader_Name := pack.Info.Desc[PackageInfo_Name]; FHeader_Copyright := pack.Info.Desc[PackageInfo_Copyright]; FHeader_Version := pack.Info.Desc[PackageInfo_Version]; diff --git a/windows/src/developer/TIKE/web/UmodWebHttpServer.pas b/windows/src/developer/TIKE/web/UmodWebHttpServer.pas index d0985f943f..db0bbf7a2b 100644 --- a/windows/src/developer/TIKE/web/UmodWebHttpServer.pas +++ b/windows/src/developer/TIKE/web/UmodWebHttpServer.pas @@ -55,16 +55,17 @@ type procedure DataModuleCreate(Sender: TObject); procedure DataModuleDestroy(Sender: TObject); private - FApp: TAppHttpServer; - FDebugger: TDebuggerHttpServer; - function GetApp: TAppHttpServer; - function GetDebugger: TDebuggerHttpServer; + FApp: TAppHttpResponder; + FDebugger: TDebuggerHttpResponder; + function GetApp: TAppHttpResponder; + function GetDebugger: TDebuggerHttpResponder; public function GetURL: string; + function GetLocalhostURL: string; procedure GetURLs(v: TStrings); - property Debugger: TDebuggerHttpServer read GetDebugger; - property App: TAppHttpServer read GetApp; + property Debugger: TDebuggerHttpResponder read GetDebugger; + property App: TAppHttpResponder read GetApp; end; var @@ -128,20 +129,25 @@ begin http.Active := False; // I4036 end; -function TmodWebHttpServer.GetApp: TAppHttpServer; +function TmodWebHttpServer.GetApp: TAppHttpResponder; begin if not Assigned(FApp) then - FApp := TAppHttpServer.Create; + FApp := TAppHttpResponder.Create; Result := FApp; end; -function TmodWebHttpServer.GetDebugger: TDebuggerHttpServer; +function TmodWebHttpServer.GetDebugger: TDebuggerHttpResponder; begin if not Assigned(FDebugger) then - FDebugger := TDebuggerHttpServer.Create; + FDebugger := TDebuggerHttpResponder.Create; Result := FDebugger; end; +function TmodWebHttpServer.GetLocalhostURL: string; +begin + Result := 'http://127.0.0.1:'+IntToStr(http.DefaultPort); +end; + function TmodWebHttpServer.GetURL: string; var str: TStringList; @@ -214,8 +220,6 @@ procedure TmodWebHttpServer.httpCommandGet(AContext: TIdContext; var doc: string; begin - // /keyboard/###.js -> looks up the list of currently testing keyboards - // everything else retrieved from xml/kmw/ doc := ARequestInfo.Document; Delete(doc, 1, 1); @@ -228,5 +232,4 @@ begin FDebugger.ProcessRequest(AContext, ARequestInfo, AResponseInfo); end; - end. diff --git a/windows/src/developer/TIKE/xml/project/distribution.xsl b/windows/src/developer/TIKE/xml/project/distribution.xsl index 22aa83c61c..4bb87723a9 100644 --- a/windows/src/developer/TIKE/xml/project/distribution.xsl +++ b/windows/src/developer/TIKE/xml/project/distribution.xsl @@ -6,9 +6,7 @@
-

Distribution - header_distrib.png -

+

Distribution

Quick Links

diff --git a/windows/src/developer/TIKE/xml/project/elements.xsl b/windows/src/developer/TIKE/xml/project/elements.xsl index de05e7c027..fb4fb31cab 100644 --- a/windows/src/developer/TIKE/xml/project/elements.xsl +++ b/windows/src/developer/TIKE/xml/project/elements.xsl @@ -4,8 +4,8 @@ - project.css - + + @@ -44,7 +44,7 @@ - icon_ + res/icon_ .png file.gif @@ -118,7 +118,7 @@ - - icon32_arrow.gif - + - - icon32_plus.gif - + @@ -239,7 +235,7 @@ help:reference/file-types/ - icon32_. + res/icon32_.
. diff --git a/windows/src/developer/TIKE/xml/project/keyboards.xsl b/windows/src/developer/TIKE/xml/project/keyboards.xsl index 66968e3ae8..5dc620dee2 100644 --- a/windows/src/developer/TIKE/xml/project/keyboards.xsl +++ b/windows/src/developer/TIKE/xml/project/keyboards.xsl @@ -6,44 +6,56 @@
-

Keyboards - header_keyboard.png -

+

+ Keyboards +

Quick Links

- +

Creating your first keyboard

- -

Click the New Keyboard button to create a keyboard for any device. This will open the Keyboard Editor, where you can - create a keyboard visually, or programatically with the Keyman Keyboard Language.

+ +

+ Click the New Keyboard button to create a keyboard for any device. This will open the Keyboard Editor, where you can + create a keyboard visually, or programatically with the Keyman Keyboard Language. +

  • - The Layout page in the Keyboard Editor lets you quickly create - a keyboard using a visual representation of a computer keyboard. You can drag and drop characters from the + The Layout page in the Keyboard Editor lets you quickly create + a keyboard using a visual representation of a computer keyboard. You can drag and drop characters from the Character Map to create Unicode keyboard layouts.
  • - The Source tab of the layout page shows the keyboard's design in the + The Source tab of the layout page shows the keyboard's design in the Keyman Keyboard Language. From here, you can enhance keyboards with input management features such as constraints, dead keys, character reordering, and more. Read the Tutorial for an introduction to these features.
- -

It's a good idea to read Developing Open Source Keyboards for guidelines - on preparing open source keyboards for sharing through the Keyman keyboard repositories. Also see the Distribution tab for more on - distributing your completed keyboards.

- + +

+ It's a good idea to read Developing Open Source Keyboards for guidelines + on preparing open source keyboards for sharing through the Keyman keyboard repositories. Also see the Distribution tab for more on + distributing your completed keyboards. +

+ - + + + + + @@ -107,7 +119,11 @@ - () + + + () + + true @@ -117,68 +133,96 @@ - +
- menu_options_ + + menu_options_ + Open - keyman:openfile?id= + + keyman:openfile?id= + Build - keyman:compilefile?id= + + keyman:compilefile?id= + Clean - keyman:cleanfile?id= + + keyman:cleanfile?id= + View Source - keyman:viewfilesource?id= + + keyman:viewfilesource?id= + Open in External Editor - keyman:editfileexternal?id= + + keyman:editfileexternal?id= + Open Containing Folder - keyman:opencontainingfolder?id= + + keyman:opencontainingfolder?id= + Remove from Project - keyman:removefile?id= + + keyman:removefile?id= +
- +
Source Files Outputs
Source Files Outputs
- + + - + + - + + - + +
Full path:Full path: + +
Copyright:Copyright: + +
Version:Version: + +
Message:Message: + +
- + @@ -186,16 +230,22 @@ - + - - kbdbitmap + + + + kbdbitmap + - keyman:editfile?id= + + keyman:editfile?id= + -
+ +
diff --git a/windows/src/developer/TIKE/xml/project/packages.xsl b/windows/src/developer/TIKE/xml/project/packages.xsl index f280857cf4..3420a42437 100644 --- a/windows/src/developer/TIKE/xml/project/packages.xsl +++ b/windows/src/developer/TIKE/xml/project/packages.xsl @@ -6,9 +6,7 @@
-

- header_package.png -

+

Quick Links

diff --git a/windows/src/developer/TIKE/xml/project/project.xsl b/windows/src/developer/TIKE/xml/project/project.xsl index 5e352da8a2..784591757e 100644 --- a/windows/src/developer/TIKE/xml/project/project.xsl +++ b/windows/src/developer/TIKE/xml/project/project.xsl @@ -27,30 +27,22 @@
- Welcome - tab_welcome.gif - + Welcome Welcome
- Keyboards - tab_keyboard.png - + Keyboards Keyboards
- Packaging - tab_package.png - + Packaging Packaging
- Distribution - tab_distrib.png - + Distribution Distribution
diff --git a/windows/src/developer/TIKE/xml/project/welcome.xsl b/windows/src/developer/TIKE/xml/project/welcome.xsl index 9b008355d4..5333d0f092 100644 --- a/windows/src/developer/TIKE/xml/project/welcome.xsl +++ b/windows/src/developer/TIKE/xml/project/welcome.xsl @@ -6,9 +6,7 @@
-

Welcome - header_welcome.gif -

+

Welcome

Quick Links