paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 07:59:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add Debug Window dialog showing the number of running webserver processes

Browse Source 
git-svn-id: trunk@56827 -
This commit is contained in:
michael 2017-12-23 15:28:26 +00:00
parent 025579133c
commit 306bfa36c4
11 changed files with 512 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -3773,6 +3773,8 @@ components/pas2js/frmpas2jsbrowserprojectoptions.lfm svneol=native#text/plain
components/pas2js/frmpas2jsbrowserprojectoptions.pp svneol=native#text/plain
components/pas2js/frmpas2jsnodejsprojectoptions.lfm svneol=native#text/plain
components/pas2js/frmpas2jsnodejsprojectoptions.pp svneol=native#text/plain
components/pas2js/frmpas2jswebservers.lfm svneol=native#text/plain
components/pas2js/frmpas2jswebservers.pp svneol=native#text/plain
components/pas2js/languages/pjsdsgnregister.po svneol=native#text/plain
components/pas2js/languages/pjsdsgnregister.pt_BR.po svneol=native#text/plain
components/pas2js/languages/pjsdsgnregister.ru.po svneol=native#text/plain
@ -3783,6 +3785,7 @@ components/pas2js/pjsdsgnoptions.pas svneol=native#text/plain
components/pas2js/pjsdsgnoptsframe.lfm svneol=native#text/plain
components/pas2js/pjsdsgnoptsframe.pas svneol=native#text/plain
components/pas2js/pjsdsgnregister.pas svneol=native#text/plain
components/pas2js/strpas2jsdesign.pp svneol=native#text/plain
components/plotfunction/demo/event/frmmain.lfm svneol=native#text/plain
components/plotfunction/demo/event/frmmain.pp svneol=native#text/plain
components/plotfunction/demo/event/ploteventdemo.ico -text svneol=unset#image/ico

1
components/pas2js/frmpas2jsbrowserprojectoptions.lfm
View File

@ -7,6 +7,7 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
ClientHeight = 344
ClientWidth = 426
OnCreate = FormCreate
OnShow = FormShow
LCLVersion = '1.9.0.0'
object CBCreateHTML: TCheckBox
Left = 16

29
components/pas2js/frmpas2jsbrowserprojectoptions.pp
View File

@ -27,6 +27,7 @@ type
procedure CBCreateHTMLChange(Sender: TObject);
procedure CBUseHTTPServerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
function GetB(AIndex: Integer): Boolean;
function GetServerPort: Word;
@ -78,7 +79,11 @@ procedure TWebBrowserProjectOptionsForm.CBUseHTTPServerChange(Sender: TObject);
begin
C.Enabled:=CBUseHTTPServer.Checked;
if C is TRadioButton then
TRadioButton(C).Checked:=False;
if not C.Enabled then
begin
Writeln('Unchecking ',C.Name);
TRadioButton(C).Checked:=False;
end;
end;
begin
@ -94,6 +99,13 @@ begin
CBUseHTTPServerChange(Self);
end;
procedure TWebBrowserProjectOptionsForm.FormShow(Sender: TObject);
begin
// Need to do this again, in case options were set before show
CBCreateHTMLChange(self);
CBUseHTTPServerChange(Self);
end;
function TWebBrowserProjectOptionsForm.GetB(AIndex: Integer): Boolean;
begin
Case Aindex of
@ -107,6 +119,7 @@ begin
else
Result:=False;
end;
// Writeln('Reporting ',AIndex,' : ',Result);
end;
function TWebBrowserProjectOptionsForm.GetServerPort: Word;
@ -126,8 +139,18 @@ begin
1 : CBMaintainPage.Checked:=AValue;
2 : CBUseBrowserApp.Checked:=AValue;
3 : CBUseBrowserConsole.Checked:=AValue;
4 : RBStartServerAt.Checked:=AValue;
5 : RBUseURL.Checked:=AValue;
4 :
begin
RBStartServerAt.Checked:=AValue;
if AValue then
CBUseHTTPServer.Checked:=true
end;
5 :
begin
RBUseURL.Checked:=AValue;
if AValue then
CBUseHTTPServer.Checked:=true
end;
6 : CBRunOnReady.Checked:=Avalue;
end;
end;

197
components/pas2js/frmpas2jswebservers.lfm Normal file
View File

@ -0,0 +1,197 @@
object PasJSWebserverProcessesForm: TPasJSWebserverProcessesForm
Left = 560
Height = 245
Top = 270
Width = 644
Caption = 'Web server processes'
ClientHeight = 245
ClientWidth = 644
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
LCLVersion = '1.9.0.0'
object LLCount: TLabel
Left = 16
Height = 17
Top = 8
Width = 185
AutoSize = False
Caption = 'Number of webserver processes:'
ParentColor = False
end
object LCount: TLabel
AnchorSideLeft.Control = LLCount
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = LLCount
Left = 209
Height = 17
Top = 8
Width = 39
BorderSpacing.Left = 8
Caption = 'LCount'
ParentColor = False
end
object LVProcesses: TListView
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = SBrefresh
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 189
Top = 48
Width = 628
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Columns = <
item
Caption = 'Port'
end
item
Caption = 'Status'
Width = 80
end
item
Caption = 'Root Directory'
Width = 200
end
item
Caption = 'Project'
Width = 200
end
item
AutoSize = True
Caption = 'Additional info'
Width = 88
end>
SmallImages = ILProcesses
StateImages = ILProcesses
TabOrder = 0
ViewStyle = vsReport
end
object SBrefresh: TSpeedButton
AnchorSideTop.Control = LLCount
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 598
Height = 32
Top = 8
Width = 38
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00A465
34A2A4653401FFFFFF00FFFFFF00A4653405A4653453A76A3ABEA66938E9A466
35FAA76A3AE4A76B3BAAA4653424FFFFFF00FFFFFF00FFFFFF00FFFFFF00A465
34FFA5673693FFFFFF00A4653454A66737EEB58055F3CEA684FFD8B697FFDBB9
99FFD3AC8AFFC2946DFCA66838F6A466355BFFFFFF00FFFFFF00FFFFFF00A567
37FEB7845BF7A56736D4B17A4EF4E3CAB4FFECDAC9FFE7D1BCFFE3C9B0FFDEBE
A0FFD2AB88FFCEA582FFD3AE8EFFA66838F5A465342AFFFFFF00FFFFFF00A668
38FDF1E4D8FFD4B295FEF4E9E0FFF3E8DDFFEDDCCCFFD2AD8FFEB0784CF5A566
35FBA66939FFA66939FEA96D3DFFB0784CFFA76A3AA8FFFFFF00FFFFFF00A567
37FDF6EEE6FFF5ECE3FFF5EDE4FFE6D2C1FFB0794DF5A66938CAA4653436FFFF
FF00A465346AA96B3CEDB67C4FFFA76A3AFEA56837FAFFFFFF00FFFFFF00A466
35FCF6EEE6FFEBD7C4FFEAD9C9FFA46534FEA465346AFFFFFF00FFFFFF00FFFF
FF00A465340BA56635E9C9956C8DB77F53C2A46534FFA4653405FFFFFF00A465
34FCF5EDE5FFF6EDE5FFF5ECE4FFD7B79CFDA66837E0A4653410FFFFFF00FFFF
FF00FFFFFF00FFFFFF00D5A47E1ACD997239A46534FCA465340CFFFFFF00A465
34F9A46534FEA46534FEA46534FDA46534FCA46534FBA46534B9A465341DA465
3418A4653418A4653418A4653418A4653418A465341CFFFFFF00FFFFFF00A465
340DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A46534A0A465
34FFAD7447F8AF774CF7AF774CF7AF784CF7A46534FFA4653408FFFFFF00A465
34FCB3794C7ECF9D762BBB835713A4653402FFFFFF00FFFFFF00A4653404A668
38C4D0AC8FFAF6EEE7FFF2E6DBFFF6EEE6FFA66A3AFBA4653409FFFFFF00A465
35FEA76A3AFBC791689DA56737E6A4653423FFFFFF00FFFFFF00FFFFFF00A465
3460A46635FFE9D7C7FFEBD8C6FFF5ECE3FFA66A3AFAA465340AFFFFFF00A668
38F3AB7041FFA96C3CFEA76A3AF5A4653475A4653419A4653445A66938CDB988
61F5EBDBCDFFF5EBE2FFF6EEE6FFF6EEE6FFA76A3AFAA465340BFFFFFF00A769
399BC09069FDC59872FFA86B3CFFA46635FFA76A3AFCB7855DF3D9BBA1FEF1E4
D8FFF2E6DBFFF3E8DDFFCEA788FDEAD8C8FFA76A3AF9A465340DFFFFFF00A465
3429A66939F5D3AD8CFFDCBD9DFFDDBEA1FFE5CBB4FFE9D3BFFFEEDDCCFFF0E2
D5FFE7D2BFFFAF774BF5A56736C0AB7143F7A46635FCA465340EFFFFFF00FFFF
FF00A4653550A66838F6C09068FAD3B08FFFDFC2A8FFDEC1A8FFD4B193FFB987
5FF4A56737F0A4653458FFFFFF00A4663566A46534FFA465340FFFFFFF00FFFF
FF00FFFFFF00A465341DA7693A9FA76A3ADEA56736F6A76939E5A76A3ABCA465
3453A4653405FFFFFF00FFFFFF00FFFFFF00A4653479A4653410
}
OnClick = SBrefreshClick
end
object ILProcesses: TImageList
left = 146
top = 107
Bitmap = {
4C69020000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF003DBFEC033CBCEBD43ABAEAC339B8E803FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF003CBCEB9585D4F1FF82D1F0FF37B5E769FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF003CBCEB123ABAE9F2F1FAFDFFD5EFFAFF35B2E6ED33AFE412FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF003AB9E9B494D8F2FFF3FCFEFFE7FAFEFF8FD3F0FF31ACE396FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003AB9
E93038B7E8FDF9FDFFFF94E9F9FF9EEBFAFFECFAFEFF2FA9E1FC2DA6E030FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B7
E8D4A9DFF4FFEDF9FDFF3EA3D6FF3EA3D6FFD4F5FCFFA2D7F1FF2BA3DEC3FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B6E85A71C8
EDFFF9FEFFFF5EDCF4FF3EA2D5FF3EA2D5FF5CD9F4FFEDFBFEFF68BBE5FF269C
DB5AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B6E80C36B4E6ECC8EA
F7FFE6FAFDFF5DDAF4FF3DA1D5FF3DA1D5FF57D7F2FFC7F3FCFFC0E3F4FF2499
D9E42296D80CFFFFFF00FFFFFF00FFFFFF00FFFFFF0036B3E6AA8CD2F0FFEAFB
FEFF94E6F8FF5CDAF4FF47B1DDFF3DA1D5FF56D7F2FF5CDBF5FFDEF8FDFF7DC0
E7FF1D8ED487FFFFFF00FFFFFF00FFFFFF0036B3E62434B1E5FBF3FBFEFFC3F2
FBFF5CDCF6FF5CDAF4FF64DFF6FF57CBEBFF55D6F2FF54D9F5FF94E7F8FFE3F4
FBFF1787D0F91380CD24FFFFFF00FFFFFF0034B0E5CA9DD7F1FFE7F9FDFF8BE5
F8FF5ADBF6FF5BDAF4FF3DA1D5FF3DA1D5FF54D6F2FF52D8F5FF50D6F4FFD8F6
FCFF88BFE5FF0E79C9B4FFFFFF0034B0E54B62BFE8FFF4FCFEFFB5EFFAFF58DA
F5FF58DAF5FF57D8F3FF58D7F2FF58D6F2FF57D9F4FF51D8F5FF4ED7F4FF62DA
F6FFEAFBFEFF4493D2FF066DC34B31ADE3E3BEE3F5FFF4FCFEFFEFFBFEFFEEFB
FEFFEEFBFEFFEFFCFEFFEFFCFEFFEFFBFEFFEEFBFEFFEDFBFEFFEDFBFEFFECFB
FEFFF2FCFEFFABCEEBFF0368C1D82FAAE2A22DA7E0FF2BA4DFFF29A1DDFF279E
DCFF259BDAFF2398D9FF2093D6FF1B8CD3FF1685CFFF117ECCFF0D77C9FF0971
C6FF066CC3FF0368C1FF0064BFA2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000031D6FFFF52A5FFFF527BC6FF000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000031D6FFFF42DE
FFFF10D6FFFF5AA5FFFF527BC6FF000000000000000000000000000000000000
00000000000000000000000000000000000031D6FFFF00F7FFFF00EFFFFF00AD
FFFF00A5FFFF527BC6FF00000000000000000000000000000000000000000000
0000000000000000000031D6FFFF08F7FFFF00FFFFFF00F7FFFF00D6FFFF00B5
FFFF527BC6FF0000000000000000000000000000000000000000000000000000
000008C6FFFF39E7FFFF4AEFFFFF42F7FFFF18FFFFFF00FFFFFF00FFFFFF08FF
FFFF21FFFFFF527BC6FF000000000000000000000000000000000000000039A5
FFFF00C6FFFF00EFFFFF00F7FFFF00EFFFFF00DEFFFF00FFFFFF00FFFFFF39EF
FFFF08C6FFFF527BC6FF000000000000000000000000000000000000000029AD
FFFF00C6FFFF00EFFFFF00F7FFFF00F7FFFF00FFFFFF4AEFFFFF18CEFFFF00A5
FFFF527BC6FF000000000000000000000000000000000000000000000000527B
C6FF527BC6FF527BC6FF00C6FFFF08FFFFFF31F7FFFF10BDFFFF00ADFFFF527B
C6FF527BC6FF0000000000000000000000000000000000000000000000000000
0000000000000000000000B5FFFF08BDFFFF00ADFFFF009CFFFF527BC6FF0000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000B5FFFF08C6FFFF009CFFFF009CFFFF527BC6FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000B5FFFF008CFFFF0094FFFF527BC6FF527BC6FF00000000000000000000
000000000000000000000000000000000000000000000000000000000000009C
FFFF008CFFFF008CFFFF527BC6FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000397BE7FF007B
FFFF0073F7FF527BC6FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000317BEFFF527B
C6FF296BC6FF0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000527BC6FF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
end

168
components/pas2js/frmpas2jswebservers.pp Normal file
View File

@ -0,0 +1,168 @@
unit frmpas2jswebservers;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Grids,
ComCtrls, Buttons, pjscontroller;
type
{ TPasJSWebserverProcessesForm }
TPasJSWebserverProcessesForm = class(TForm)
ILProcesses: TImageList;
LLCount: TLabel;
LCount: TLabel;
LVProcesses: TListView;
SBrefresh: TSpeedButton;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SBrefreshClick(Sender: TObject);
private
Class Var
TheForm : TPasJSWebserverProcessesForm;
procedure DoControllerRefresh(Sender: TObject);
procedure Localize;
procedure ServerInstanceToListItem(LI: TListItem; SI: TServerInstance);
public
Class Function Instance : TPasJSWebserverProcessesForm;
Procedure RefreshList;
end;
implementation
uses strpas2jsdesign;
{$R *.lfm}
Const
iiStopped = 0;
iiRunning = 1;
{ TPasJSWebserverProcessesForm }
procedure TPasJSWebserverProcessesForm.FormShow(Sender: TObject);
begin
TPJSController.Instance.OnRefresh:=@DoControllerRefresh;
RefreshList;
end;
procedure TPasJSWebserverProcessesForm.SBrefreshClick(Sender: TObject);
begin
RefreshList;
end;
procedure TPasJSWebserverProcessesForm.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
CloseAction:=caFree;
end;
procedure TPasJSWebserverProcessesForm.FormCreate(Sender: TObject);
begin
Localize;
end;
procedure TPasJSWebserverProcessesForm.Localize;
begin
LLCount.Caption:= SWebserversCount;
Caption:=SWebserversCaption;
With LVProcesses do
begin
Column[0].Caption:=SWebserversPort;
Column[1].Caption:=SWebserversStatus;
Column[2].Caption:=SWebserversBaseDir;
Column[3].Caption:=SWebserversProject;
Column[4].Caption:=SWebserversExtra;
end;
end;
procedure TPasJSWebserverProcessesForm.FormDestroy(Sender: TObject);
begin
TPJSController.Instance.OnRefresh:=Nil;
if (Self=TheForm) then
TheForm:=Nil;
end;
procedure TPasJSWebserverProcessesForm.ServerInstanceToListItem(LI : TListItem;SI : TServerInstance);
Var
S,SError : String;
begin
LI.Caption:=IntToStr(SI.Port);
If SI.Running then
begin
LI.ImageIndex:=iiRunning;
S:=SStatusRunning;
end
else if (SI.RunError<>'') then
begin
S:=SStatusError;
SError:=SI.RunError;
end
else
begin
LI.ImageIndex:=iiStopped;
S:=SStatusStopped;
end;
LI.SubItems.Add(S);
LI.SubItems.Add(SI.BaseDir);
LI.SubItems.Add(SI.LastProject);
LI.SubItems.Add(SError);
LI.Data:=SI;
end;
procedure TPasJSWebserverProcessesForm.DoControllerRefresh(Sender: TObject);
begin
RefreshList;
end;
class function TPasJSWebserverProcessesForm.Instance: TPasJSWebserverProcessesForm;
begin
if TheForm=Nil then
TheForm:=TPasJSWebserverProcessesForm.Create(Application);
Result:=TheForm;
end;
procedure TPasJSWebserverProcessesForm.RefreshList;
Var
C : TPJSController;
I : integer;
LI : TListItem;
SI : TServerInstance;
begin
C:=TPJSController.Instance;
if (C=Nil) or (C.ServerInstances=Nil) or (C.ServerInstances.Count=0) then
begin
LVProcesses.Items.Clear;
LCount.Caption:='0';
exit;
end;
LCount.Caption:=IntToStr(C.ServerInstances.Count);
With LVProcesses.Items do
try
BeginUpdate;
Clear;
For I:=0 to C.ServerInstances.Count-1 do
begin
SI:=C.ServerInstances[i];
LI:=Add;
ServerInstanceToListItem(LI,SI);
end;
finally
EndUpdate;
end;
end;
end.

10
components/pas2js/pas2jsdsgn.lpk
View File

@ -18,7 +18,7 @@
<Description Value="Adds a Lazarus project for pas2js browser applications."/>
<License Value="GPL-2"/>
<Version Major="1" Release="1"/>
<Files Count="6">
<Files Count="8">
<Item1>
<Filename Value="pjsdsgnregister.pas"/>
<HasRegisterProc Value="True"/>
@ -44,6 +44,14 @@
<Filename Value="pjscontroller.pp"/>
<UnitName Value="pjscontroller"/>
</Item6>
<Item7>
<Filename Value="frmpas2jswebservers.pp"/>
<UnitName Value="frmpas2jswebservers"/>
</Item7>
<Item8>
<Filename Value="strpas2jsdesign.pp"/>
<UnitName Value="strpas2jsdesign"/>
</Item8>
</Files>
<i18n>
<EnableI18N Value="True"/>

2
components/pas2js/pas2jsdsgn.pas
View File

@ -10,7 +10,7 @@ interface
uses
PJSDsgnRegister, PJSDsgnOptsFrame, frmpas2jsbrowserprojectoptions,
PJSDsgnOptions, frmpas2jsnodejsprojectoptions, pjscontroller,
LazarusPackageIntf;
frmpas2jswebservers, strpas2jsdesign, LazarusPackageIntf;
implementation

51
components/pas2js/pjscontroller.pp
View File

@ -5,7 +5,7 @@ unit pjscontroller;
interface
uses
Classes, SysUtils, MacroIntf, MacroDefIntf, forms, lazideintf, process ;
Classes, SysUtils, MacroIntf, MacroDefIntf, forms, lazideintf, lazlogger, process ;
Type
@ -13,8 +13,10 @@ Type
TServerInstance = Class(TCollectionItem)
private
FlastProject: String;
FPort: Word;
FProcess: TProcess;
FRunError: String;
FServerName: String;
FString: String;
function GetRunning: Boolean;
@ -28,6 +30,8 @@ Type
Property BaseDir : String Read FString Write FString;
Property ServerName : String Read FServerName Write FServerName;
Property Running : Boolean Read GetRunning;
Property RunError : String Read FRunError;
Property LastProject : String Read FlastProject Write Flastproject;
end;
{ TServerInstanceList }
@ -39,12 +43,13 @@ Type
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;
Property Instances [AIndex : Integer] : TServerInstance Read GetInstance; default;
end;
{ TPJSController }
TPJSController = Class
Private
FOnRefresh: TNotifyEvent;
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;
@ -57,7 +62,9 @@ Type
Class Function instance : TPJSController;
Procedure Hook; virtual;
Procedure UnHook; virtual;
Procedure RefreshView;
Property ServerInstances : TServerInstanceList Read FServerInstances;
Property OnRefresh : TNotifyEvent Read FOnRefresh Write FonRefresh;
end;
Const
@ -139,15 +146,25 @@ begin
{$IFDEF WINDOWS}
FProcess.Options:=[poNoConsole];
{$ENDIF}
// Writeln('Starting server from Directory : ',BaseDir);
DebugLN(['Starting server from Directory : ',BaseDir]);
FProcess.CurrentDirectory:=BaseDir;
FProcess.Execute;
try
FProcess.Execute;
except
On E : Exception do
begin
FRunError:=E.Message;
Raise;
end;
end;
TPJSController.Instance.RefreshView;
end;
procedure TServerInstance.StopServer;
begin
if Running then
FProcess.Terminate(0);
TPJSController.Instance.RefreshView;
end;
class procedure TPJSController.DoneInstance;
@ -196,17 +213,16 @@ Var
FN : String;
begin
DebugLN(['LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]]);
Abort:=LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]<>'1';
// Writeln('LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectWebBrowser]);
if Abort then
exit;
DebugLN(['LazarusIDE.ActiveProject.CustomData[PJSProjectURL]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectURL]]);
Result:=LazarusIDE.ActiveProject.CustomData[PJSProjectURL];
// Writeln('LazarusIDE.ActiveProject.CustomData[PJSProjectURL]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectURL]);
if (Result='') then
begin
FN:=LazarusIDE.ActiveProject.CustomData[PJSProjectHTMLFile];
// Writeln('LazarusIDE.ActiveProject.CustomData[PJSProjectHTMLFile]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectHTMLFile]);
DebugLN(['LazarusIDE.ActiveProject.CustomData[PJSProjectHTMLFile]: ',LazarusIDE.ActiveProject.CustomData[PJSProjectHTMLFile]]);
if (FN='') then
FN:=ChangeFileExt(ExtractFileName(LazarusIDE.ActiveProject.ProjectInfoFile),'.html');
Result:=LazarusIDE.ActiveProject.CustomData[PJSProjectPort];
@ -220,7 +236,7 @@ begin
{$ENDIF}
end;
Abort:=(Result='');
// Writeln('GetProjectURL : ',Result);
DebugLN(['GetProjectURL : ',Result]);
end;
function TPJSController.MaybeStartServer(Sender: TObject; var Handled: boolean): TModalResult;
@ -234,9 +250,9 @@ Var
begin
With LazarusIDE.ActiveProject do
begin
// Writeln('WebProject:=',CustomData[PJSProjectWebBrowser]='1');
// Writeln('ServerPort:=',CustomData[PJSProjectPort]);
// Writeln('BaseDir:=',ProjectInfoFile);
DebugLn(['WebProject:=',CustomData[PJSProjectWebBrowser]]);
DebugLn(['ServerPort:=',CustomData[PJSProjectPort]]);
DebugLn(['BaseDir:=',ProjectInfoFile]);
WebProject:=CustomData[PJSProjectWebBrowser]='1';
ServerPort:=StrToIntDef(CustomData[PJSProjectPort],0);
BaseDir:=ExtractFilePath(ProjectInfoFile);
@ -247,10 +263,10 @@ begin
aInstance:=ServerInstances.FindByPort(ServerPort);
If Ainstance<>Nil then
begin
// Writeln('Have instance running on port ',ServerPort);
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);
Writeln('Instance on port ',ServerPort,' serves different directory: ',aInstance.BaseDir);
// We should ask the user what to do ?
If aInstance.Running then
aInstance.StopServer;
@ -261,6 +277,7 @@ begin
// Writeln('No instance running on port ',ServerPort, 'allocating it');
aInstance:=ServerInstances.AddInstance(ServerPort,BaseDir,PJSOptions.GetParsedHTTPServerFilename);
end;
aInstance.LastProject:=LazarusIDE.ActiveProject.ProjectInfoFile;
aInstance.StartServer;
Handled:=False;
end;
@ -291,6 +308,12 @@ begin
// Nothing for the moment
end;
procedure TPJSController.RefreshView;
begin
If Assigned(FOnRefresh) then
FOnRefresh(Self);
end;
finalization
TPJSController.DoneInstance;
end.

3
components/pas2js/pjsdsgnoptions.pas
View File

@ -11,8 +11,7 @@ interface
uses
Classes, SysUtils, LazFileCache, LazConfigStorage, LazFileUtils, FileUtil,
MacroIntf, BaseIDEIntf, IDEUtils,
DefineTemplates;
MacroIntf, BaseIDEIntf, IDEUtils, DefineTemplates;
const
PJSDsgnOptsFile = 'pas2jsdsgnoptions.xml';

58
components/pas2js/pjsdsgnregister.pas
View File

@ -5,9 +5,8 @@ unit PJSDsgnRegister;
interface
uses
Classes, SysUtils, Forms, Controls,
ProjectIntf, CompOptsIntf, LazIDEIntf, IDEOptionsIntf,
PJSDsgnOptions, PJSDsgnOptsFrame;
Classes, SysUtils, Forms, Controls, ProjectIntf, CompOptsIntf, LazIDEIntf, IDEOptionsIntf,
PJSDsgnOptions, PJSDsgnOptsFrame, LazLogger;
const
ProjDescNamePas2JSWebApp = 'Web Application';
@ -83,7 +82,17 @@ procedure Register;
implementation
uses frmpas2jsnodejsprojectoptions, frmpas2jsbrowserprojectoptions, pjscontroller;
uses
frmpas2jswebservers,
frmpas2jsnodejsprojectoptions,
frmpas2jsbrowserprojectoptions,
pjscontroller, strpas2jsdesign, MenuIntf;
procedure ShowServerDialog(Sender: TObject);
begin
TPasJSWebserverProcessesForm.Instance.Show;
TPasJSWebserverProcessesForm.Instance.BringToFront;
end;
procedure Register;
@ -97,6 +106,7 @@ begin
// add options frame
PJSOptionsFrameID:=RegisterIDEOptionsEditor(GroupEnvironment,TPas2jsOptionsFrame,
PJSOptionsFrameID)^.Index;
RegisterIdeMenuCommand(itmViewDebugWindows,SPasJSWebservers,SPasJSWebserversCaption,nil,@ShowServerDialog);
end;
{ TProjectPas2JSNodeJSApp }
@ -290,9 +300,8 @@ function TProjectPas2JSWebApp.GetNextPort : Word;
begin
Result:=PJSOptions.StartAtPort+1;
PJSOptions.StartAtPort:=1;
PJSOptions.StartAtPort:=Result;
PJSOptions.Save;
end;
function TProjectPas2JSWebApp.ShowOptionsDialog : TModalResult;
@ -303,11 +312,13 @@ function TProjectPas2JSWebApp.ShowOptionsDialog : TModalResult;
Result:=O in Options;
end;
Procedure So(Value : Boolean; o : TBrowserApplicationOption);
Procedure So(AValue : Boolean; o : TBrowserApplicationOption);
begin
if Value then
Include(Foptions,O);
if AValue then
Include(Foptions,O)
else
Exclude(Foptions,O)
end;
@ -320,14 +331,11 @@ begin
UseBrowserConsole:=CO(baoUseBrowserConsole);
StartHTTPServer:=CO(baoStartServer);
UseRunOnReady:=CO(baoRunOnReady);
if CO(baoStartServer) then
ServerPort:=GetNextPort
else
begin
// We allocate the new port in all cases.
ServerPort:=GetNextPort;
URL:='';
if Not CO(baoStartServer) then
UseURL:=CO(baoUseURL);
if CO(baoUseURL) then
URL:='';
end;
Result:=ShowModal;
if Result=mrOK then
begin
@ -337,11 +345,11 @@ begin
SO(UseBrowserConsole,baoUseBrowserConsole);
SO(StartHTTPServer,baoStartServer);
SO(UseRunOnReady,baoRunOnReady);
// Writeln('Start server: ', CO(baoStartServer));
DebugLN(['Start server:', CO(baoStartServer)]);
if CO(baoStartServer) then
begin
Self.ProjectPort:=ServerPort;
// Writeln('Start server port: ', Self.ProjectPort,'from; ',ServerPort);
DebugLN(['Start server port: ', Self.ProjectPort,'from: ',ServerPort]);
end
else
begin
@ -357,6 +365,10 @@ end;
function TProjectPas2JSWebApp.DoInitDescriptor: TModalResult;
begin
// Reset options
FOptions:=[baoCreateHtml,baoMaintainHTML];
ProjectPort:=0;
ProjectURL:='';
Result:=ShowOptionsDialog;
end;
@ -530,12 +542,12 @@ begin
AProject.CustomData.Values[PJSProjectPort]:=IntToStr(ProjectPort);
AProject.CustomData.Values[PJSProjectURL]:='';
end;
{ With AProject.CustomData do
With AProject.CustomData do
begin
Writeln(PJSProjectWebBrowser,Values[PJSProjectWebBrowser]);
Writeln(PJSProjectPort,Values[PJSProjectPort]);
Writeln(ProjectURL,Values[PJSProjectURL]);
end;}
DebugLN([PJSProjectWebBrowser,': ',Values[PJSProjectWebBrowser]]);
DebugLN([PJSProjectPort,': ',Values[PJSProjectPort]]);
DebugLN([PJSProjectURL,': ',Values[PJSProjectURL]]);
end;
// create html source
if baoCreateHtml in Options then
CreateHTMLFile(aProject,'project1.js');

34
components/pas2js/strpas2jsdesign.pp Normal file
View File

@ -0,0 +1,34 @@
unit strpas2jsdesign;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
Resourcestring
// menu item
SPasJSWebservers = 'Pas2JSWebservers';
SPasJSWebserversCaption = 'Pas2JS WebServers';
// Static texts webservers form
SWebserversStatus = 'Status';
SWebserversPort = 'Port';
SWebserversBaseDir = 'Root directory';
SWebserversProject = 'Project';
SWebserversExtra = 'Additional info';
SWebserversCount = 'Number of webserver processes:';
SWebserversCaption = 'Web server processes';
// Dynamic texts webservers form
SStatusRunning = 'Running';
SStatusStopped = 'Stopped';
SStatusError = 'Error starting';
implementation
end.