spiegel-keyman/developer/src/tike/project/Keyman.Developer.UI.Project.kpsProjectFileUI.pas

(*
  Name:             Keyman.Developer.UI.Project.kpsProjectFileUI
  Copyright:        Copyright (C) 2003-2017 SIL International.
  Documentation:
  Description:
  Create Date:      4 May 2015

  Modified Date:    4 May 2015
  Authors:          mcdurdin
  Related Files:
  Dependencies:

  Bugs:
  Todo:
  Notes:
  History:          04 May 2015 - mcdurdin - I4694 - V9.0 - Split UI actions from non-UI actions in projects
*)
unit Keyman.Developer.UI.Project.kpsProjectFileUI;

interface

uses
  System.UITypes,
  KPSFile,
  Menus,
  Keyman.Developer.System.Project.ProjectFile,
  Keyman.Developer.UI.Project.ProjectFilesUI,
  Keyman.Developer.UI.Project.ProjectFileUI,
  Keyman.Developer.System.Project.kpsProjectFileAction;

type
  TkpsProjectFileUI = class(TOpenableProjectFileUI)
  private
    function TestPackageOnline: Boolean;
    function InstallPackage: Boolean;
    function UninstallPackage: Boolean;
    function CompilePackage: Boolean;

    function GetProjectFile: TkpsProjectFileAction;
    function TestPackageState(FCompiledName: string): Boolean;
  public
    function DoAction(action: TProjectFileAction; FSilent: Boolean): Boolean; override;
    property ProjectFile: TkpsProjectFileAction read GetProjectFile;
  end;

implementation

uses
  System.SysUtils,

  Windows,
  Dialogs,
  dmActionsMain,
  Controls,
  Keyman.Developer.System.Project.Project,
  Keyman.Developer.System.ServerAPI,
  Keyman.Developer.UI.Project.ProjectUIFileType,
  Keyman.Developer.UI.ServerUI,
  UfrmMain,
  UfrmMessages,
  UfrmMDIEditor,
  UfrmPackageEditor,
  UmodWebHttpServer,
  utilexecute,
  Variants,
  ShellApi,
  KeymanDeveloperUtils,
  PackageInfo;

function TkpsProjectFileUI.CompilePackage: Boolean;
begin
  Result := False;
  if ProjectFile.Modified then
    if not modActionsMain.actFileSave.Execute then Exit;

  Result := ProjectFile.CompilePackage;

  if Result and
      TServerDebugAPI.Running and
      TServerDebugAPI.IsPackageRegistered(ProjectFile.TargetFileName) then
    TestPackageOnline;
end;

function TkpsProjectFileUI.DoAction(action: TProjectFileAction; FSilent: Boolean): Boolean;
begin
  case action of
    pfaCompile: Result := CompilePackage;
    pfaInstall: Result := InstallPackage;
    pfaUninstall: Result := UninstallPackage;
    pfaClean: Result := ProjectFile.Clean;
    pfaTestKeymanWeb: Result := TestPackageOnline;
  else
    Result := False;
  end;
end;

function TkpsProjectFileUI.GetProjectFile: TkpsProjectFileAction;
begin
  Result := FOwner as TkpsProjectFileAction;
end;

function TkpsProjectFileUI.InstallPackage: Boolean;
var
  FCompiledName: string;
begin
  Result := False;
  FCompiledName := ProjectFile.TargetFilename;
  if not TestPackageState(FCompiledName) then Exit;
  KeymanDeveloperUtils.InstallPackage(FCompiledName, True);
  Result := True;
end;

function TkpsProjectFileUI.TestPackageOnline: Boolean;
var
  FCompiledName: string;
  editor: TfrmTikeEditor;
  packageEditor: TfrmPackageEditor;
begin
  editor := frmKeymanDeveloper.FindEditorByFileName(ProjectFile.FileName);   // I4021
  if not Assigned(editor) or not (editor is TfrmPackageEditor) then
    Exit(False);
  packageEditor := editor as TfrmPackageEditor;

  FCompiledName := ProjectFile.TargetFilename;
  if not FileExists(FCompiledName) then
    Exit(False);

  if TServerUI.VerifyServerRunning then
  begin
    TServerDebugAPI.RegisterPackage(FCompiledName, ProjectFile.Header_Name);
    packageEditor.NotifyStartedWebDebug;   // I4021
  end;

  Result := True;
end;

function TkpsProjectFileUI.UninstallPackage: Boolean;
begin
  Result := KeymanDeveloperUtils.UninstallPackage(ChangeFileExt(ExtractFileName(ProjectFile.FileName), ''));
end;

function TkpsProjectFileUI.TestPackageState(FCompiledName: string): Boolean;
var
  ftkps, ftkmp: TDateTime;
begin
  Result := False;

  if not FileExists(FCompiledName) then
    case MessageDlg('You need to compile the keyboard before you can test it.  Compile now?',
        mtConfirmation, mbOkCancel, 0) of
      mrOk:     if not CompilePackage then Exit;
      mrCancel: Exit;
    end;

  FileAge(ProjectFile.FileName, ftkps);
  FileAge(FCompiledName, ftkmp);

  if ProjectFile.Modified or (ftkps > ftkmp) then
    case MessageDlg('The source file has changed.  Recompile before testing?',
        mtConfirmation, mbYesNoCancel, 0) of
      mrYes:    if not CompilePackage then Exit;
      mrNo:     ;
      mrCancel: Exit;
    end;

  Result := True;
end;

initialization
  RegisterProjectFileUIType(TkpsProjectFileAction, TkpsProjectFileUI);
end.