lazarus/components/pas2js/pjscontroller.pp

unit PJSController;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, process,
  // LazUtils
  LazLoggerBase, LazUtilities, FileUtil, LazFileUtils, AvgLvlTree,
  // LCL
  Forms, Controls, LazHelpIntf,
  // IdeIntf
  MacroIntf, MacroDefIntf, ProjectIntf, CompOptsIntf, IDEExternToolIntf,
  LazIDEIntf, ProjectGroupIntf,
  // pas2js
  SimpleWebSrvController, StrPas2JSDesign, PJSDsgnOptions, CodeToolManager,
  CodeCache;

Type

  { TPJSController }

  TPJSController = Class
  Private
    FMacroPas2js: TTransferMacro;
    FOnRefresh: TNotifyEvent;
    function GetPas2JSPath(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
    function GetPas2JSBrowser(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
    function GetPas2JSNodeJS(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
    function GetPas2JSElectron(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
    function GetPas2jsProjectURL(const s: string; const {%H-}Data: PtrInt; var Abort: boolean): string;
    function OnProjectBuilding(Sender: TObject): TModalResult;
    function OnProjectGroupRunLazbuild({%H-}Target: TPGCompileTarget;
      Tool: TAbstractExternalTool): boolean;
    function OnRunDebugInit(Sender: TObject; var Handled: boolean
      ): TModalResult;
    function OnRunWithoutDebugInit(Sender: TObject; var Handled: boolean): TModalResult;
    function RunProject(Sender: TObject; WithDebug: boolean; var Handled: boolean): TModalResult;
    function RunBrowserProject(aProject: TLazProject; WithDebug: boolean; var Handled: boolean): TModalResult;
    function RunNonBrowserProject(aProject: TLazProject; WithDebug: boolean; var Handled: boolean): TModalResult;
    function SaveHTMLFileToTestDir(aProject: TLazProject): boolean;
    class function GetProjectHTMLLegacyFilename(aProject: TLazProject): string;
  Public
    Constructor Create;
    Destructor Destroy; override;
    Class Procedure DoneInstance;
    Class Function Instance: TPJSController;
    Procedure Hook; virtual;
    Procedure UnHook; virtual;
    Procedure StoreMacros; virtual;
    // Determine project HTML file from custom data
    class function GetProjectHTMLFile(aProject: TLazProject): TLazProjectFile;
    class function GetProjectHTMLFilename(aProject: TLazProject): string;
    // Get filename to show in browser when running
    function GetHTMLFilename(aProject: TLazProject; UseTestDir: boolean): string; virtual;
    function GetWebDir(aProject: TLazProject): string; virtual; // disk directory for webserver
    function GetProjectLocation(aProject: TLazProject): string; virtual;
    function GetProjectURL(aProject: TLazProject): string; virtual;
    Property OnRefresh : TNotifyEvent Read FOnRefresh Write FonRefresh;
    property MacroPas2js: TTransferMacro read FMacroPas2js;
  end;

Const
  // Custom settings in .lpi
  PJSProject = 'Pas2JSProject'; // Project is pas2js project
  PJSProjectWebBrowser =  'PasJSWebBrowserProject'; // Web browser project
  PJSProjectHTMLFile = 'PasJSHTMLFile' deprecated 'use TPJSController.GetProjectHTMLFilename'; // No longer used
  PJSIsProjectHTMLFile = 'PasJSIsProjectHTMLFile';
  PJSProjectMaintainHTML = 'MaintainHTML';
  PJSProjectUseBrowserConsole = 'BrowserConsole';
  PJSProjectRunAtReady = 'RunAtReady';
  PJSProjectLocation = 'PasJSLocation';
  PJSProjectPort = 'PasJSPort';
  PJSProjectURL = 'PasJSURL';
  PJSProjectHTMLBaseDir = 'HTMLDir';

implementation

Var
  ctrl : TPJSController;

{ TPJSController }

class procedure TPJSController.DoneInstance;
begin
  FreeAndNil(Ctrl)
end;

class function TPJSController.Instance: TPJSController;
begin
  if Ctrl=Nil then
    Ctrl:=TPJSController.Create;
  Result:=Ctrl;
end;

function TPJSController.GetPas2JSPath(const s: string; const Data: PtrInt;
  var Abort: boolean): string;
begin
  Abort:=False;
  if (s<>'') and (ConsoleVerbosity>=0) then
    debugln(['Hint: (lazarus) [TPJSController.GetPas2JSPath] ignoring macro Pas2JS parameter "',s,'"']);
  Result:=PJSOptions.GetParsedCompilerFilename;
  if Result='' then
    Result:='pas2js'; // always return something to get nicer error messages
end;

function TPJSController.GetPas2JSBrowser(const s: string; const Data: PtrInt; var Abort: boolean): string;
var
  Params: TStringList;
begin
  Abort:=False;
  if (s<>'') and (ConsoleVerbosity>=0) then
    debugln(['Hint: (lazarus) [TPJSController.GetPas2JSBrowser] ignoring macro Pas2JSBrowser parameter "',s,'"']);
  Params:=TStringList.Create;
  try
    Result:=SimpleWebServerController.GetBrowser('',Params);
  finally
    Params.Free;
  end;
  if Result='' then
    Result:='firefox'; // always return something to get nicer error messages
end;

function TPJSController.GetPas2JSNodeJS(const s: string; const Data: PtrInt; var Abort: boolean): string;

begin
  Abort:=False;
  if (s<>'') and (ConsoleVerbosity>=0) then
    debugln(['Hint: (lazarus) [TPJSController.GetPas2JSNodeJS] ignoring macro Pas2JSNodeJS parameter "',s,'"']);
  Result:=PJSOptions.GetParsedNodeJSFilename;
  if Result='' then
    Result:='nodejs'+GetExeExt; // always return something to get nicer error messages
end;

function TPJSController.GetPas2JSElectron(const s: string; const Data: PtrInt;
  var Abort: boolean): string;
begin
  Abort:=False;
  if (s<>'') and (ConsoleVerbosity>=0) then
    debugln(['Hint: (lazarus) [TPJSController.GetPas2JSElectron] ignoring macro Pas2JSElectron parameter "',s,'"']);
  Result:=PJSOptions.GetParsedElectronExe;
  if Result='' then
    Result:='electron'+GetExeExt; // always return something to get nicer error messages
end;

function TPJSController.GetPas2jsProjectURL(const s: string; const Data: PtrInt; var Abort: boolean): string;
Var
  aProject: TLazProject;
begin
  if (s<>'') and (ConsoleVerbosity>=0) then
    debugln(['Hint: (lazarus) [TPJSController.GetPas2jsProjectURL] ignoring macro Pas2JSProjectURL parameter "',s,'"']);

  aProject:=LazarusIDE.ActiveProject;
  if ConsoleVerbosity>0 then
    DebugLN(['Hint: (lazarus) [TPJSController.GetPas2jsProjectURL] LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]: ',aProject.CustomData[PJSProjectWebBrowser]]);
  Abort:=aProject.CustomData[PJSProjectWebBrowser]<>'1';
  if Abort then
    exit;
  if ConsoleVerbosity>0 then
    DebugLN(['Hint: (lazarus) [TPJSController.GetPas2jsProjectURL] LazarusIDE.ActiveProject.CustomData[PJSProjectURL]: ',aProject.CustomData[PJSProjectURL]]);
  Result:=GetProjectURL(aProject);
  Abort:=(Result='');
  if ConsoleVerbosity>0 then
    DebugLN(['Hint: (lazarus) [TPJSController.GetPas2jsProjectURL] Result="',Result,'"']);
end;


function TPJSController.OnProjectBuilding(Sender: TObject): TModalResult;
var
  aProject: TLazProject;
begin
  Result:=mrOk;
  aProject:=LazarusIDE.ActiveProject;
  if aProject=nil then exit;
  StoreMacros;
  if aProject.IsVirtual then
    begin
    if not SaveHTMLFileToTestDir(aProject) then
      exit(mrCancel);
    end;
end;

function TPJSController.OnProjectGroupRunLazbuild(Target: TPGCompileTarget;
  Tool: TAbstractExternalTool): boolean;
var
  Pas2jsFilename: String;
begin
  Result:=true;
  Pas2jsFilename:=PJSOptions.GetParsedCompilerFilename;
  if Pas2jsFilename<>'' then
    Tool.EnvironmentOverrides.Values['PAS2JS']:=Pas2jsFilename;
end;

function TPJSController.OnRunDebugInit(Sender: TObject; var Handled: boolean
  ): TModalResult;
begin
  Result:=RunProject(Sender,true,Handled);
end;

function TPJSController.OnRunWithoutDebugInit(Sender: TObject; var Handled: boolean): TModalResult;
begin
  Result:=RunProject(Sender,false,Handled);
end;

class function TPJSController.GetProjectHTMLFile(aProject: TLazProject
  ): TLazProjectFile;
var
  HTMLFilename: String;
  i: Integer;
begin
  for i:=0 to aProject.FileCount-1 do
    begin
    Result:=aProject.Files[i];
    if Result.IsPartOfProject
        and (Result.CustomData[PJSIsProjectHTMLFile]='1') then
      exit;
    end;
  Result:=nil;

  HTMLFilename:=GetProjectHTMLLegacyFilename(aProject);
  if HTMLFilename<>'' then
    Result:=aProject.FindFile(HTMLFilename,[pfsfOnlyProjectFiles]);
end;

class function TPJSController.GetProjectHTMLFilename(aProject: TLazProject): string;

Var
  aFile: TLazProjectFile;

begin
  aFile:=GetProjectHTMLFile(aProject);
  if aFile<>nil then
    Result:=aFile.GetFullFilename
  else
    Result:='';
end;

function TPJSController.GetHTMLFilename(aProject: TLazProject; UseTestDir: boolean): string;
begin
  Result:=GetProjectHTMLFileName(aProject);
  if Result='' then exit;
  if FilenameIsAbsolute(Result) then exit;

  if aProject.IsVirtual then
    begin
    if UseTestDir then
      Result:=AppendPathDelim(LazarusIDE.GetTestBuildDirectory)+Result;
    end
  else
    Result:=TrimFilename(AppendPathDelim(aProject.Directory)+Result);
end;

function TPJSController.GetWebDir(aProject: TLazProject): string;
var
  HTMLFilename: String;
begin
  Result:='';

  HTMLFilename:=GetHTMLFilename(aProject,true);
  if HTMLFilename<>'' then
    Result:=ExtractFilePath(HTMLFilename);

  if Result='' then
    if aProject.IsVirtual then
      Result:=LazarusIDE.GetTestBuildDirectory
    else
      Result:=ExtractFilePath(aProject.ProjectInfoFile);
end;

function TPJSController.GetProjectLocation(aProject: TLazProject): string;
begin
  Result:=aProject.CustomData[PJSProjectLocation];
  IDEMacros.SubstituteMacros(Result);
end;

function TPJSController.GetProjectURL(aProject: TLazProject): string;
Var
  HTMLFilename, WebDir: String;
  Port: LongInt;
begin
  if aProject=nil then
    exit('');
  Result:=aProject.CustomData[PJSProjectURL];
  if Result<>'' then
    begin
    IDEMacros.SubstituteMacros(Result);
    exit;
    end;

  if Result='' then
    begin
    Port:=StrToIntDef(aProject.CustomData[PJSProjectPort],-1);
    HTMLFilename:=GetHTMLFilename(aProject,true);
    if HTMLFilename='' then
      begin
      if Port<=0 then
        HTMLFilename:=ChangeFileExt(aProject.ProjectInfoFile,'.html')
      else
        HTMLFilename:=ExtractFileNameOnly(aProject.ProjectInfoFile)+'.html';
      end
    else if Port>0 then
      begin
      WebDir:=GetWebDir(aProject);
      HTMLFilename:=CreateRelativePath(HTMLFilename,WebDir);
      end;
    HTMLFilename:=FilenameToURLPath(HTMLFilename);
    if Port<=0 then
      Result:='file://'+HTMLFilename
    else
      Result:='http://127.0.0.1:'+IntToStr(Port)+'/'+HTMLFilename;
    end;
end;

function TPJSController.RunProject(Sender: TObject; WithDebug: boolean;
  var Handled: boolean): TModalResult;
var
  aProject: TLazProject;
  IsWebProject, IsPSProject: Boolean;
begin
  Result:=mrOk;
  if Sender=nil then ;

  aProject:=LazarusIDE.ActiveProject;
  if aProject=nil then exit;

  IsWebProject:=aProject.CustomData[PJSProjectWebBrowser]='1';
  if IsWebProject then
    begin
    Result:=RunBrowserProject(aProject,WithDebug,Handled);
    exit;
    end;

  IsPSProject:=aProject.CustomData[PJSProject]='1';
  if IsPSProject then
    begin
    Result:=RunNonBrowserProject(aProject,WithDebug,Handled);
    exit;
    end;
end;

function TPJSController.RunBrowserProject(aProject: TLazProject;
  WithDebug: boolean; var Handled: boolean): TModalResult;
var
  ServerPort: Integer;
  WebDir, HTMLFilename, URL, WorkDir, Location: String;
  aServer: TSWSInstance;
  SWSLocation: TSWSLocation;
begin
  Result:=mrOk;
  aProject:=LazarusIDE.ActiveProject;

  if SimpleWebServerController.Options.ServerExe='compileserver'+GetExeExt then
    begin
    // simplewebservergui package has default value
    if CompareFilenames(ExtractFilename(PJSOptions.OldWebServerFileName),'compileserver'+GetExeExt)=0 then
      begin
      // user had used compileserver too -> migrate to simplewebservergui once
      SimpleWebServerController.Options.ServerExe:=PJSOptions.OldWebServerFileName;
      SimpleWebServerController.Options.SaveSafe;
      PJSOptions.OldWebServerFileName:='';
      PJSOptions.Save;
      end;
    end;

  Location:=aProject.CustomData[PJSProjectLocation];
  ServerPort:=StrToIntDef(aProject.CustomData[PJSProjectPort],-1);
  URL:=aProject.CustomData[PJSProjectURL];
  if (Location='') and (ServerPort<0) and (URL='') then
    exit; // compile normally and run the run-parameters

  // Run webproject with Debug: build, start webserver, open browser

  Handled:=true;

  // compile
  Result:=LazarusIDE.DoBuildProject(crRun,[]);
  if Result<>mrOk then exit;

  if WithDebug then ;

  if (Location<>'') or (ServerPort>=0) then
    begin
    // start http server
    WebDir:=GetWebDir(aProject);
    if WebDir='' then
      begin
      debugln(['Warning: TPJSController.RunProject missing webdir']);
      exit(mrCancel);
      end;
    if WebDir='' then
      exit(mrCancel);

    SWSLocation:=nil;
    if Location<>'' then
      begin
      Location:=GetProjectLocation(aProject);
      if Location='' then
        Location:=ExtractFileNameOnly(aProject.MainFile.Filename);
      SWSLocation:=SimpleWebServerController.AddProjectLocation(aProject,Location,WebDir,true);
      if SWSLocation=nil then
        exit(mrCancel);
      if SWSLocation.ErrorDesc<>'' then
        exit(mrCancel);
      end
    else
      begin
      aServer:=SimpleWebServerController.AddProjectServer(aProject,ServerPort,WebDir,true);
      if aServer=nil then
        exit(mrCancel);
      if aServer.ErrorDesc<>'' then
        exit(mrCancel);
      end;

    // start browser
    HTMLFilename:=GetHTMLFilename(aProject,true);
    if HTMLFilename='' then
      begin
      debugln(['Info: TPJSController.RunProject missing htmlfile']);
      exit(mrCancel);
      end;

    if SWSLocation<>nil then
      begin
      if not SimpleWebServerController.OpenBrowserWithLocation(SWSLocation,HTMLFilename) then
        exit(mrCancel);
      end
    else
      begin
      if not SimpleWebServerController.OpenBrowserWithServer(aServer,HTMLFilename) then
        exit(mrCancel);
      end;

    end
  else
    begin
    // start browser with user URL
    URL:=GetProjectURL(aProject);
    if aProject.IsVirtual then
      WorkDir:=LazarusIDE.GetTestBuildDirectory
    else
      WorkDir:=ExtractFilePath(aProject.ProjectInfoFile);
    if not SimpleWebServerController.OpenBrowserWithURL(URL,WorkDir) then
      exit(mrCancel);
    end;
end;

function TPJSController.RunNonBrowserProject(aProject: TLazProject;
  WithDebug: boolean; var Handled: boolean): TModalResult;
begin
  Result:=mrOk;

  if not WithDebug then
    exit; // compile normally and run the run-parameters

  if aProject=nil then ;

  // for now: redirect to run without debug
  Handled:=true;
  Result:=LazarusIDE.DoRunProjectWithoutDebug;
end;

function TPJSController.SaveHTMLFileToTestDir(aProject: TLazProject): boolean;
var
  HTMLFilename, FullHTMLFilename: String;
  HTMLFile: TLazProjectFile;
  Code: TCodeBuffer;
begin
  // if project has a pas2js html filename, save it to the test directory
  Result:=false;
  HTMLFilename:=GetProjectHTMLFilename(aProject);
  if (HTMLFilename='') then
    exit(true);
  if FilenameIsAbsolute(HTMLFilename) then
    begin
    debugln(['Warning: TPJSController.SaveHTMLFileToTestDir html file is absolute: "',HTMLFilename,'"']);
    exit(true);
    end;
  HTMLFile:=aProject.FindFile(HTMLFilename,[pfsfOnlyProjectFiles]);
  if HTMLFile=nil then
    begin
    debugln(['Warning: TPJSController.SaveHTMLFileToTestDir invalid project filename [',HTMLFilename,']']);
    exit;
    end;
  HTMLFilename:=HTMLFile.Filename;

  Code:=CodeToolBoss.FindFile(HTMLFilename);
  if Code=nil then
    begin
    debugln(['Error: TPJSController.SaveHTMLFileToTestDir missing codebuffer "',HTMLFilename,'"']);
    exit;
    end;

  FullHTMLFilename:=AppendPathDelim(LazarusIDE.GetTestBuildDirectory)+HTMLFilename;
  if not Code.SaveToFile(FullHTMLFilename) then
    begin
    debugln(['Error: TPJSController.SaveHTMLFileToTestDir write error: ',Code.LastError,' File="',FullHTMLFilename,'"']);
    exit;
    end;

  Result:=true;
end;

class function TPJSController.GetProjectHTMLLegacyFilename(aProject: TLazProject
  ): string;
begin
  Result:=aProject.CustomData.Values[PJSProjectHTMLFile{%H-}];
  if Result='' then exit;
  DoDirSeparators(Result);
  if (not aProject.IsVirtual) and (not FilenameIsAbsolute(Result)) then
    Result:=TrimFilename(AppendPathDelim(aProject.Directory)+Result);
end;

constructor TPJSController.Create;
begin
  // Nothing for the moment
end;

destructor TPJSController.Destroy;
begin
  Unhook;
  inherited Destroy;
end;

procedure TPJSController.Hook;
begin
  FMacroPas2js:=IDEMacros.Add('Pas2JS', '', pjsdPas2JSExecutable, @GetPas2JSPath, [tmfLazbuild]);
  IDEMacros.Add(TTransferMacro.Create('Pas2JSBrowser', '',
    pjsdPas2JSSelectedBrowserExecutable, @GetPas2JSBrowser, []));
  IDEMacros.Add(TTransferMacro.Create('Pas2JSNodeJS', '',
    pjsdPas2JSSelectedNodeJSExcutable, @GetPas2JSNodeJS, []));
  IDEMacros.Add(TTransferMacro.Create('Pas2JSElectron', '',
    pjsdPas2JSSelectedElectronExcutable, @GetPas2JSElectron, []));
  IDEMacros.Add(TTransferMacro.Create('Pas2JSProjectURL', '',
    pjsdPas2JSCurrentProjectURL, @GetPas2jsProjectURL, []));
  LazarusIDE.AddHandlerOnProjectBuilding(@OnProjectBuilding);
  LazarusIDE.AddHandlerOnRunDebugInit(@OnRunDebugInit);
  LazarusIDE.AddHandlerOnRunWithoutDebugInit(@OnRunWithoutDebugInit);
  ProjectGroupManager.AddHandlerOnRunLazbuild(@OnProjectGroupRunLazbuild);
end;

procedure TPJSController.UnHook;
begin
  FMacroPas2js:=nil;
end;

procedure TPJSController.StoreMacros;
begin
  if PJSOptions=nil then exit;
  FMacroPas2js.LazbuildValue:=PJSOptions.GetParsedCompilerFilename;
end;

finalization
  TPJSController.DoneInstance;
end.