* Add option to set rtl.showUncaughtExceptions

git-svn-id: trunk@63172 -
This commit is contained in:
michael 2020-05-16 11:55:12 +00:00
parent 257f95ec97
commit 4a6326ea3c
3 changed files with 64 additions and 41 deletions

View File

@ -1,11 +1,11 @@
object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
Left = 431 Left = 431
Height = 344 Height = 383
Top = 310 Top = 310
Width = 426 Width = 491
Caption = 'Pas2JS Browser project options' Caption = 'Pas2JS Browser project options'
ClientHeight = 344 ClientHeight = 383
ClientWidth = 426 ClientWidth = 491
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
@ -14,9 +14,9 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 6 Left = 6
Height = 19 Height = 23
Top = 6 Top = 6
Width = 151 Width = 164
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Create initial HTML page' Caption = 'Create initial HTML page'
@ -27,12 +27,12 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
end end
object CBUseBrowserApp: TCheckBox object CBUseBrowserApp: TCheckBox
AnchorSideLeft.Control = CBCreateHTML AnchorSideLeft.Control = CBCreateHTML
AnchorSideTop.Control = CBRunOnReady AnchorSideTop.Control = cbShowUncaughtExceptions
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 23
Top = 81 Top = 122
Width = 184 Width = 200
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Use Browser Application object' Caption = 'Use Browser Application object'
TabOrder = 1 TabOrder = 1
@ -42,18 +42,18 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = CBUseBrowserApp AnchorSideTop.Control = CBUseBrowserApp
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 23
Top = 106 Top = 151
Width = 294 Width = 314
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Use Browser Console unit to display writeln() output' Caption = 'Use Browser Console unit to display writeln() output'
TabOrder = 2 TabOrder = 2
end end
object BPHelpOptions: TButtonPanel object BPHelpOptions: TButtonPanel
Left = 6 Left = 6
Height = 34 Height = 39
Top = 304 Top = 338
Width = 414 Width = 479
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton' HelpButton.Name = 'HelpButton'
@ -70,8 +70,8 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = RBStartServerAt AnchorSideTop.Control = RBStartServerAt
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 70 Left = 70
Height = 23 Height = 29
Top = 177 Top = 234
Width = 75 Width = 75
BorderSpacing.Left = 32 BorderSpacing.Left = 32
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -85,9 +85,9 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = CBUseBrowserConsole AnchorSideTop.Control = CBUseBrowserConsole
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 23
Top = 131 Top = 180
Width = 168 Width = 185
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Project needs a HTTP Server' Caption = 'Project needs a HTTP Server'
OnChange = CBUseHTTPServerChange OnChange = CBUseHTTPServerChange
@ -98,9 +98,9 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = CBUseHTTPServer AnchorSideTop.Control = CBUseHTTPServer
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 38 Left = 38
Height = 19 Height = 23
Top = 156 Top = 209
Width = 154 Width = 169
BorderSpacing.Left = 32 BorderSpacing.Left = 32
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Start HTTP Server on port' Caption = 'Start HTTP Server on port'
@ -113,9 +113,9 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = SEPort AnchorSideTop.Control = SEPort
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 38 Left = 38
Height = 19 Height = 23
Top = 202 Top = 265
Width = 148 Width = 163
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Use this URL to start app' Caption = 'Use this URL to start app'
TabOrder = 7 TabOrder = 7
@ -127,13 +127,13 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 70 Left = 70
Height = 23 Height = 29
Top = 223 Top = 290
Width = 344 Width = 409
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 12 BorderSpacing.Right = 12
ItemHeight = 15 ItemHeight = 0
TabOrder = 8 TabOrder = 8
end end
object CBMaintainPage: TCheckBox object CBMaintainPage: TCheckBox
@ -141,9 +141,9 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = CBCreateHTML AnchorSideTop.Control = CBCreateHTML
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 23
Top = 31 Top = 35
Width = 132 Width = 142
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Maintain HTML Page' Caption = 'Maintain HTML Page'
TabOrder = 9 TabOrder = 9
@ -153,11 +153,23 @@ object WebBrowserProjectOptionsForm: TWebBrowserProjectOptionsForm
AnchorSideTop.Control = CBMaintainPage AnchorSideTop.Control = CBMaintainPage
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 23
Top = 56 Top = 64
Width = 268 Width = 290
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Run rtl when all page resources are fully loaded' Caption = 'Run rtl when all page resources are fully loaded'
TabOrder = 10 TabOrder = 10
end end
object cbShowUncaughtExceptions: TCheckBox
AnchorSideLeft.Control = CBRunOnReady
AnchorSideTop.Control = CBRunOnReady
AnchorSideTop.Side = asrBottom
Left = 6
Height = 23
Top = 93
Width = 208
BorderSpacing.Top = 6
Caption = 'Let rtl show uncaught exceptions'
TabOrder = 11
end
end end

View File

@ -21,6 +21,7 @@ type
CBServerURL: TComboBox; CBServerURL: TComboBox;
CBMaintainPage: TCheckBox; CBMaintainPage: TCheckBox;
CBRunOnReady: TCheckBox; CBRunOnReady: TCheckBox;
cbShowUncaughtExceptions: TCheckBox;
RBUseURL: TRadioButton; RBUseURL: TRadioButton;
RBStartServerAt: TRadioButton; RBStartServerAt: TRadioButton;
SEPort: TSpinEdit; SEPort: TSpinEdit;
@ -43,6 +44,7 @@ type
property StartHTTPServer : Boolean Index 4 read GetB Write SetB; property StartHTTPServer : Boolean Index 4 read GetB Write SetB;
property UseURL : Boolean Index 5 read GetB Write SetB; property UseURL : Boolean Index 5 read GetB Write SetB;
property UseRunOnReady : Boolean Index 6 read GetB Write SetB; property UseRunOnReady : Boolean Index 6 read GetB Write SetB;
property ShowUncaughtExceptions : Boolean Index 7 read GetB Write SetB;
Property ServerPort : Word Read GetServerPort Write SetServerPort; Property ServerPort : Word Read GetServerPort Write SetServerPort;
Property URL : String Read GetURL Write SetURL; Property URL : String Read GetURL Write SetURL;
end; end;
@ -121,6 +123,7 @@ begin
4 : Result:=RBStartServerAt.Checked; 4 : Result:=RBStartServerAt.Checked;
5 : Result:=RBUseURL.Checked; 5 : Result:=RBUseURL.Checked;
6 : Result:=CBRunOnReady.Checked; 6 : Result:=CBRunOnReady.Checked;
7 : Result:=cbShowUncaughtExceptions.Checked;
else else
Result:=False; Result:=False;
end; end;
@ -157,6 +160,7 @@ begin
CBUseHTTPServer.Checked:=true CBUseHTTPServer.Checked:=true
end; end;
6 : CBRunOnReady.Checked:=Avalue; 6 : CBRunOnReady.Checked:=Avalue;
7 : cbShowUncaughtExceptions.Checked:=aValue;
end; end;
end; end;

View File

@ -29,7 +29,8 @@ type
baoUseBrowserApp, // Use browser app object baoUseBrowserApp, // Use browser app object
baoUseBrowserConsole, // use browserconsole unit to display Writeln() baoUseBrowserConsole, // use browserconsole unit to display Writeln()
baoStartServer, // Start simple server baoStartServer, // Start simple server
baoUseURL // Use this URL to run/show project in browser baoUseURL, // Use this URL to run/show project in browser
baoShowException // let RTL show uncaught exceptions
); );
TBrowserApplicationOptions = set of TBrowserApplicationOption; TBrowserApplicationOptions = set of TBrowserApplicationOption;
@ -337,6 +338,7 @@ begin
UseBrowserConsole:=CO(baoUseBrowserConsole); UseBrowserConsole:=CO(baoUseBrowserConsole);
StartHTTPServer:=CO(baoStartServer); StartHTTPServer:=CO(baoStartServer);
UseRunOnReady:=CO(baoRunOnReady); UseRunOnReady:=CO(baoRunOnReady);
ShowUncaughtExceptions:=CO(baoShowException);
// We allocate the new port in all cases. // We allocate the new port in all cases.
ServerPort:=GetNextPort; ServerPort:=GetNextPort;
URL:=''; URL:='';
@ -351,6 +353,7 @@ begin
SO(UseBrowserConsole,baoUseBrowserConsole); SO(UseBrowserConsole,baoUseBrowserConsole);
SO(StartHTTPServer,baoStartServer); SO(StartHTTPServer,baoStartServer);
SO(UseRunOnReady,baoRunOnReady); SO(UseRunOnReady,baoRunOnReady);
SO(ShowUncaughtExceptions,baoShowException);
DebugLN(['Start server:', CO(baoStartServer)]); DebugLN(['Start server:', CO(baoStartServer)]);
if CO(baoStartServer) then if CO(baoStartServer) then
begin begin
@ -424,10 +427,14 @@ begin
Content:=''; Content:='';
if baoUseBrowserConsole in Options then if baoUseBrowserConsole in Options then
Content:=ConsoleDiv; Content:=ConsoleDiv;
if baoRunOnReady in Options then if baoShowException in Options then
RunScript:='window.addEventListener("load", rtl.run);'+LineEnding Runscript:='rtl.showUncaughtExceptions=true;'+LineEnding+' ';
else else
RunScript:='rtl.run();'+LineEnding; RunScript:='';
if baoRunOnReady in Options then
RunScript:=Runscript+'window.addEventListener("load", rtl.run);'+LineEnding
else
RunScript:=Runscript+'rtl.run();'+LineEnding;
HTMLSource:=Format(TemplateHTMLSource,[aFileName,RunScript,Content]); HTMLSource:=Format(TemplateHTMLSource,[aFileName,RunScript,Content]);
HTMLFile.SetSourceText(HTMLSource); HTMLFile.SetSourceText(HTMLSource);
Result:=HTMLFile; Result:=HTMLFile;