* Fix bug #32870. Starting webserver to run the project now works

git-svn-id: trunk@56825 -

components/pas2js/frmpas2jsbrowserprojectoptions.lfm

@@ -6,6 +6,7 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
   Caption = 'Pas2JS Browser project options'
   ClientHeight = 344
   ClientWidth = 426
+  OnCreate = FormCreate
   LCLVersion = '1.9.0.0'
   object CBCreateHTML: TCheckBox
     Left = 16
@@ -13,7 +14,9 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
     Top = 8
     Width = 162
     Caption = 'Create initial HTML page'
+    Checked = True
     OnChange = CBCreateHTMLChange
+    State = cbChecked
     TabOrder = 0
   end
   object CBUseBrowserApp: TCheckBox
@@ -81,6 +84,7 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
     Width = 183
     BorderSpacing.Top = 2
     Caption = 'Project needs a HTTP Server'
+    OnChange = CBUseHTTPServerChange
     TabOrder = 5
   end
   object RBStartServerAt: TRadioButton
@@ -125,7 +129,6 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
     BorderSpacing.Right = 12
     ItemHeight = 0
     TabOrder = 8
-    Text = 'CBServerURL'
   end
   object CBMaintainPage: TCheckBox
     AnchorSideLeft.Control = CBCreateHTML
@@ -146,8 +149,8 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
     Left = 16
     Height = 22
     Top = 54
-    Width = 183
+    Width = 288
-    Caption = 'Run rtl in document.onReady'
+    Caption = 'Run rtl when all page resources are fully loaded'
     TabOrder = 10
   end
 end

components/pas2js/frmpas2jsbrowserprojectoptions.pp

@@ -25,6 +25,8 @@ type
     RBStartServerAt: TRadioButton;
     SEPort: TSpinEdit;
     procedure CBCreateHTMLChange(Sender: TObject);
+    procedure CBUseHTTPServerChange(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
   private
     function GetB(AIndex: Integer): Boolean;
     function GetServerPort: Word;
@@ -69,6 +71,29 @@ begin
   DoCB(CBMaintainPage);
 end;
 
+procedure TWebBrowserProjectOptionsForm.CBUseHTTPServerChange(Sender: TObject);
+
+  procedure disen(C : TControl);
+
+  begin
+    C.Enabled:=CBUseHTTPServer.Checked;
+    if C is TRadioButton then
+      TRadioButton(C).Checked:=False;
+  end;
+
+begin
+  disen(RBStartServerAt);
+  disen(RBUseURL);
+  disen(SEPort);
+  disen(CBServerURL);
+end;
+
+procedure TWebBrowserProjectOptionsForm.FormCreate(Sender: TObject);
+begin
+  CBCreateHTMLChange(self);
+  CBUseHTTPServerChange(Self);
+end;
+
 function TWebBrowserProjectOptionsForm.GetB(AIndex: Integer): Boolean;
 begin
   Case Aindex of
@@ -114,7 +139,7 @@ end;
 
 procedure TWebBrowserProjectOptionsForm.SetURL(AValue: String);
 begin
-
+  CBServerURL.Text:=AValue;
 end;
 
 end.

components/pas2js/pjscontroller.pp

@@ -5,17 +5,51 @@ unit pjscontroller;
 interface
 
 uses
-  Classes, SysUtils, MacroIntf, MacroDefIntf, lazideintf;
+  Classes, SysUtils, MacroIntf, MacroDefIntf, forms, lazideintf, process ;
 
 Type
 
+  { TServerInstance }
+
+  TServerInstance = Class(TCollectionItem)
+  private
+    FPort: Word;
+    FProcess: TProcess;
+    FServerName: String;
+    FString: String;
+    function GetRunning: Boolean;
+  Protected
+    Property Process : TProcess Read FProcess;
+  Public
+    Destructor Destroy; override;
+    Procedure StartServer;
+    Procedure StopServer;
+    Property Port : Word Read FPort Write FPort;
+    Property BaseDir : String Read FString Write FString;
+    Property ServerName : String Read FServerName Write FServerName;
+    Property Running : Boolean Read GetRunning;
+  end;
+
+  { TServerInstanceList }
+
+  TServerInstanceList = Class(TCollection)
+  private
+    function GetInstance(AIndex : Integer): TServerInstance;
+  Public
+    Function IndexOfPort(APort: Word) : integer;
+    Function FindByPort(Aindex : Integer) : TServerInstance;
+    Function AddInstance(aPort : Word; Const ABaseURL, aServerName : String) : TServerInstance;
+    Property Instances [AIndex : Integer] : TServerInstance Read GetInstance;
+  end;
   { TPJSController }
 
   TPJSController = Class
   Private
+    FServerInstances: TServerInstanceList;
     function GetPasJSBrowser(const s: string; const Data: PtrInt; var Abort: boolean): string;
     function GetPasJSNodeJS(const s: string; const Data: PtrInt; var Abort: boolean): string;
     function GetProjectURL(const s: string; const Data: PtrInt; var Abort: boolean): string;
+    function MaybeStartServer(Sender: TObject; var Handled: boolean): TModalResult;
   Public
     Constructor Create;
     Destructor Destroy; override;
@@ -23,6 +57,7 @@ Type
     Class Function instance :  TPJSController;
     Procedure Hook; virtual;
     Procedure UnHook; virtual;
+    Property ServerInstances : TServerInstanceList Read FServerInstances;
   end;
 
 Const
@@ -40,13 +75,88 @@ uses FileUtil, LazFileUtils, PJSDsgnOptions;
 Var
   ctrl : TPJSController;
 
-Class Procedure TPJSController.DoneInstance;
+{ TServerInstanceList }
+
+function TServerInstanceList.GetInstance(AIndex : Integer): TServerInstance;
+begin
+  Result:=Items[AIndex] as TServerInstance;
+end;
+
+function TServerInstanceList.IndexOfPort(APort: Word): integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (GetInstance(Result).Port<>APort) do Dec(Result);
+end;
+
+function TServerInstanceList.FindByPort(Aindex: Integer): TServerInstance;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfPort(Aindex);
+  If I=-1 then
+    Result:=nil
+  else
+    Result:=GetInstance(I);
+end;
+
+function TServerInstanceList.AddInstance(aPort: Word; const ABaseURL,
+  aServerName: String): TServerInstance;
+begin
+  Result:=Add as TServerInstance;
+  Result.Port:=aPort;
+  Result.BaseDir:=ABaseURL;
+  Result.ServerName:=aServerName;
+end;
+
+{ TServerInstance }
+
+function TServerInstance.GetRunning: Boolean;
+begin
+  Result:=Assigned(FProcess);
+  if Result then
+    Result:=Process.Running;
+end;
+
+destructor TServerInstance.Destroy;
+begin
+  StopServer;
+  FreeAndNil(FProcess);
+  inherited;
+end;
+
+procedure TServerInstance.StartServer;
+begin
+  if Running then
+    exit;
+  If not Assigned(FProcess) then
+    FProcess:=TProcess.Create(Nil);
+  FProcess.Executable:=ServerName;
+  FProcess.Parameters.Add('-q');
+  FProcess.Parameters.Add('-p');
+  FProcess.Parameters.Add(IntToStr(Port));
+  {$IFDEF WINDOWS}
+  FProcess.Options:=[poNoConsole];
+  {$ENDIF}
+//  Writeln('Starting server from Directory : ',BaseDir);
+  FProcess.CurrentDirectory:=BaseDir;
+  FProcess.Execute;
+end;
+
+procedure TServerInstance.StopServer;
+begin
+  if Running then
+    FProcess.Terminate(0);
+end;
+
+class procedure TPJSController.DoneInstance;
 
 begin
   FreeAndNil(Ctrl)
 end;
 
-Class Function TPJSController.Instance :  TPJSController;
+class function TPJSController.instance: TPJSController;
 
 begin
   if ctrl=Nil then
@@ -56,8 +166,8 @@ end;
 
 { TPJSController }
 
-function TPJSController.GetPasJSBrowser(const s: string; const Data: PtrInt;
+function TPJSController.GetPasJSBrowser(const s: string; const Data: PtrInt; var Abort: boolean): string;
-  var Abort: boolean): string;
+
 begin
   Abort:=False;
   Result:=PJSOptions.BrowserFileName;
@@ -68,8 +178,8 @@ begin
     Result:=FindDefaultExecutablePath(Result);
 end;
 
-function TPJSController.GetPasJSNodeJS(const s: string; const Data: PtrInt;
+function TPJSController.GetPasJSNodeJS(const s: string; const Data: PtrInt; var Abort: boolean): string;
-  var Abort: boolean): string;
+
 begin
   Abort:=False;
   Result:=PJSOptions.NodeJSFileName;
@@ -86,6 +196,7 @@ Var
   FN : String;
 
 begin
+
   Abort:=LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]<>'1';
 //  Writeln('LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]);
   if Abort then
@@ -112,14 +223,58 @@ begin
 //  Writeln('GetProjectURL : ',Result);
 end;
 
+function TPJSController.MaybeStartServer(Sender: TObject; var Handled: boolean): TModalResult;
+
+Var
+  ServerPort : Word;
+  WebProject : Boolean;
+  BaseDir : String;
+  aInstance : TServerInstance;
+
+begin
+  With LazarusIDE.ActiveProject do
+    begin
+//    Writeln('WebProject:=',CustomData[PJSProjectWebBrowser]='1');
+//    Writeln('ServerPort:=',CustomData[PJSProjectPort]);
+//    Writeln('BaseDir:=',ProjectInfoFile);
+    WebProject:=CustomData[PJSProjectWebBrowser]='1';
+    ServerPort:=StrToIntDef(CustomData[PJSProjectPort],0);
+    BaseDir:=ExtractFilePath(ProjectInfoFile);
+    end;
+  // Exit if we don't need to do anything
+  if Not (WebProject and (ServerPort>0)) then
+    Exit;
+  aInstance:=ServerInstances.FindByPort(ServerPort);
+  If Ainstance<>Nil then
+    begin
+//    Writeln('Have instance running on port ',ServerPort);
+    if Not SameFileName(BaseDir,aInstance.BaseDir) then
+      begin
+//      Writeln('Instance on port ',ServerPort,' serves different directory: ',aInstance.BaseDir);
+      // We should ask the user what to do ?
+      If aInstance.Running then
+        aInstance.StopServer;
+      end;
+    end
+  else
+    begin
+//    Writeln('No instance running on port ',ServerPort, 'allocating it');
+    aInstance:=ServerInstances.AddInstance(ServerPort,BaseDir,PJSOptions.GetParsedHTTPServerFilename);
+    end;
+  aInstance.StartServer;
+  Handled:=False;
+end;
+
 constructor TPJSController.Create;
 begin
   // Nothing for the moment
+  FServerInstances:=TServerInstanceList.Create(TServerInstance);
 end;
 
 destructor TPJSController.Destroy;
 begin
   Unhook;
+  FreeAndNil(FServerInstances);
   inherited Destroy;
 end;
 
@@ -128,6 +283,7 @@ begin
   IDEMacros.Add(TTransferMacro.Create('Pas2JSBrowser','','Pas2JS selected Browser executable',@GetPasJSBrowser,[]));
   IDEMacros.Add(TTransferMacro.Create('Pas2JSNodeJS','','Pas2JS selected NodeJS xecutable',@GetPasJSNodeJS,[]));
   IDEMacros.Add(TTransferMacro.Create('Pas2JSProjectURL','','Pas2JS current project URL',@GetProjectURL,[]));
+  LazarusIDE.AddHandlerOnRunWithoutDebugInit(@MaybeStartServer);
 end;
 
 procedure TPJSController.UnHook;

components/pas2js/pjsdsgnoptions.pas

@@ -50,6 +50,7 @@ Type
     procedure Load;
     procedure Save;
     function GetParsedCompilerFilename: string;
+    function GetParsedHTTPServerFilename: string;
     procedure LoadFromConfig(Cfg: TConfigStorage);
     procedure SaveToConfig(Cfg: TConfigStorage);
   public
@@ -268,6 +269,14 @@ begin
   Result:=FCompilerFilenameParsed;
 end;
 
+function TPas2jsOptions.GetParsedHTTPServerFilename: string;
+begin
+  Result:=HTTPServerFileName;
+  IDEMacros.SubstituteMacros(Result);
+  if not FilenameIsAbsolute(Result) then
+    Result:=FindDefaultExecutablePath(Result);
+end;
+
 procedure TPas2jsOptions.SetBrowserFileName(AValue: String);
 begin
   if FBrowserFileName=AValue then Exit;

components/pas2js/pjsdsgnregister.pas

@@ -223,14 +223,14 @@ begin
   Result:=pjsdNodeJSAppDescription;
 end;
 
-function TProjectPas2JSNodeJSApp.InitProject(AProject: TLazProject
+function TProjectPas2JSNodeJSApp.InitProject(AProject: TLazProject ): TModalResult;
-  ): TModalResult;
+
 var
   MainFile : TLazProjectFile;
   CompOpts : TLazCompilerOptions;
-  RunParams : TAbstractRunParamsOptions;
+  RunParams : TAbstractRunParamsOptionsMode;
+  Compiler : String;
 
-  NewSource: String;
 begin
   Result:=inherited InitProject(AProject);
 
@@ -244,15 +244,20 @@ begin
   CompOpts.Win32GraphicApp:=false;
   CompOpts.UnitOutputDirectory:='js';
   CompOpts.TargetFilename:='project1';
-  CompOpts.SetAlternativeCompile(
+  if Length(PJSOptions.CompilerFilename)=0 then
-    '$MakeExe(pas2js) -Jc -Jminclude -Tnodejs "-Fu$(ProjUnitPath)" $Name($(ProjFile))',true);
+     Compiler:='$MakeExe(pas2js)'
-  RunParams:=AProject.RunParameters;
+  else
-  //RunParams.UseLaunchingApplication:=True;
+     Compiler:=AnsiQuotedStr(PJSOptions.CompilerFilename, '"');
-  //RunParams.LaunchingApplicationPathPlusParams:='$(Pas2JSNodeJS) "$MakeDir($(ProjPath))$NameOnly($(ProjFile)).js"';
+  CompOpts.SetAlternativeCompile(Compiler+' -Jc -Jminclude -Tnodejs "-Fu$(ProjUnitPath)" $Name($(ProjFile))',true);
+
+  RunParams:=AProject.RunParameters.Find('Default');
+  if (RunParams=Nil) then
+     RunParams:=AProject.RunParameters.Add('Default');
+  RunParams.UseLaunchingApplication:=True;
+  RunParams.LaunchingApplicationPathPlusParams:='$(Pas2JSNodeJS) "$MakeDir($(ProjPath))$NameOnly($(ProjFile)).js"';
 
   // create program source
-  NewSource:=CreateProjectSource;
+  AProject.MainFile.SetSourceText(CreateProjectSource,true);
-  AProject.MainFile.SetSourceText(NewSource,true);
 
   AProject.AddPackageDependency('pas2js_rtl');
   if naoUseNodeJSApp in Options then
@@ -278,7 +283,7 @@ end;
 function TProjectPas2JSWebApp.GetBrowserCommand(AFileName : string): String;
 
 begin
-  Result:='$(Pas2JSBrowser) $(Pas2SProjectURL)';
+  Result:='$(Pas2JSBrowser) $(Pas2JSProjectURL)';
 end;
 
 function TProjectPas2JSWebApp.GetNextPort : Word;
@@ -332,8 +337,12 @@ begin
         SO(UseBrowserConsole,baoUseBrowserConsole);
         SO(StartHTTPServer,baoStartServer);
         SO(UseRunOnReady,baoRunOnReady);
+//        Writeln('Start server: ', CO(baoStartServer));
         if CO(baoStartServer) then
-          Self.ProjectPort:=ServerPort
+          begin
+          Self.ProjectPort:=ServerPort;
+//          Writeln('Start server port: ', Self.ProjectPort,'from; ',ServerPort);
+          end
         else
           begin
           UseURL:=CO(baoUseURL);
@@ -372,14 +381,16 @@ Const
     +'<head>'+LineEnding
     +'  <meta charset="utf-8">'+LineEnding
     +'  <title>Project1</title>'+LineEnding
-    +'<style>'+LineEnding
     +'  <script src="%s"></script>'+LineEnding
     +'</head>'+LineEnding
+    +'<body>'+LineEnding
     +'  <script>'+LineEnding
     +'  %s'+LineEnding
     +'  </script>'+LineEnding
     +'  %s'+LineEnding
-    +'<body>'+LineEnding;
+    +'</body>'+LineEnding
+    +'</html>'+LineEnding;
+
 
 Var
   HTMLFile : TLazProjectFile;
@@ -395,7 +406,7 @@ begin
   if baoUseBrowserConsole in Options then
     Content:=ConsoleDiv;
   if baoRunOnReady in Options then
-    RunScript:='document.onReady = rtl.run;'+LineEnding
+    RunScript:='window.addEventListener("load", rtl.run);'+LineEnding
   else
     RunScript:='rtl.run();'+LineEnding;
   HTMLSource:=Format(TemplateHTMLSource,[aFileName,RunScript,Content]);
@@ -481,7 +492,8 @@ function TProjectPas2JSWebApp.InitProject(AProject: TLazProject): TModalResult;
 var
   MainFile : TLazProjectFile;
   CompOpts: TLazCompilerOptions;
-  RunParams : TAbstractRunParamsOptions;
+  RunParams : TAbstractRunParamsOptionsMode;
+  Compiler : String;
 
 begin
   Result:=inherited InitProject(AProject);
@@ -496,11 +508,16 @@ begin
   CompOpts.Win32GraphicApp:=false;
   CompOpts.UnitOutputDirectory:='js';
   CompOpts.TargetFilename:='project1';
-  CompOpts.SetAlternativeCompile(
+  if Length(PJSOptions.CompilerFilename)=0 then
-    '$MakeExe(pas2js) -Jirtl.js -Jc -Jminclude -Tbrowser "-Fu$(ProjUnitPath)" $Name($(ProjFile))',true);
+     Compiler:='$MakeExe(pas2js)'
-  RunParams:=AProject.RunParameters;
+  else
-  //RunParams.UseLaunchingApplication:=True;
+     Compiler:=AnsiQuotedStr(PJSOptions.CompilerFilename, '"');
-  //RunParams.LaunchingApplicationPathPlusParams:=GetBrowserCommand(CompOpts.TargetFileName);
+  CompOpts.SetAlternativeCompile(Compiler+' -Jirtl.js -Jc -Jminclude -Tbrowser "-Fu$(ProjUnitPath)" $Name($(ProjFile))',true);
+  RunParams:=AProject.RunParameters.Find('Default');
+  if (RunParams=Nil) then
+     RunParams:=AProject.RunParameters.Add('Default');
+  RunParams.UseLaunchingApplication:=True;
+  RunParams.LaunchingApplicationPathPlusParams:=GetBrowserCommand(CompOpts.TargetFileName);
   AProject.MainFile.SetSourceText(CreateProjectSource,true);
   AProject.CustomData.Values[PJSProjectWebBrowser]:='1';
   if baoUseURL in Options then
@@ -513,6 +530,12 @@ begin
     AProject.CustomData.Values[PJSProjectPort]:=IntToStr(ProjectPort);
     AProject.CustomData.Values[PJSProjectURL]:='';
     end;
+{  With AProject.CustomData do
+     begin
+     Writeln(PJSProjectWebBrowser,Values[PJSProjectWebBrowser]);
+     Writeln(PJSProjectPort,Values[PJSProjectPort]);
+     Writeln(ProjectURL,Values[PJSProjectURL]);
+     end;}
   // create html source
   if baoCreateHtml in Options then
     CreateHTMLFile(aProject,'project1.js');
@@ -527,7 +550,10 @@ function TProjectPas2JSWebApp.CreateStartFiles(AProject: TLazProject
 begin
   Result:=LazarusIDE.DoOpenEditorFile(AProject.MainFile.Filename,-1,-1,
                                       [ofProjectLoading,ofRegularFile]);
-  if Result<>mrOK then exit;
+  if Result<>mrOK then
+     exit;
+
+  if baoCreateHtml in Options then
     Result:=LazarusIDE.DoOpenEditorFile('project1.html',-1,-1,
                                         [ofProjectLoading,ofRegularFile]);
 end;