paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-29 19:51:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Switch to safecall for event handlers

Browse Source
This commit is contained in:
michael 2020-05-17 08:46:34 +00:00
parent 497319ec87
commit d9238eb798
2 changed files with 53 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
demo/errorhandler/errordemo.lpr
View File

@ -5,21 +5,36 @@ program errordemo;
uses uses
BrowserConsole, JS, Classes, SysUtils, Web; BrowserConsole, JS, Classes, SysUtils, Web;
function DoRaise(aEvent : TJSMouseEvent) : boolean; Type
{ TErrorApp }
TErrorApp = class
function DoRaise(aEvent : TJSMouseEvent) : boolean;
function DoHook(aEvent : TJSMouseEvent) : boolean;
Procedure DoRaiseJS;
Procedure DoRaiseJSError;
Procedure DoPascalException(O : TObject);
Procedure DoJSException(O : TJSObject);
private
procedure Run;
end;
function TErrorApp.DoRaise(aEvent : TJSMouseEvent) : boolean;
begin begin
Result:=False; Result:=False;
raise exception.Create('A exception'); raise exception.Create('A exception');
end; end;
function DoHook(aEvent : TJSMouseEvent) : boolean; function TErrorApp.DoHook(aEvent : TJSMouseEvent) : boolean;
begin begin
Result:=False; Result:=False;
HookUncaughtExceptions; HookUncaughtExceptions;
end; end;
Procedure DoPascalException(O : TObject); Procedure TErrorApp.DoPascalException(O : TObject);
begin begin
Writeln('O :',O.ClassName); Writeln('O :',O.ClassName);
@ -27,28 +42,30 @@ begin
Writeln('Exception class message : ',Exception(O).Message); Writeln('Exception class message : ',Exception(O).Message);
end; end;
Procedure DoJSException(O : TJSObject); Procedure TErrorApp.DoJSException(O : TJSObject);
begin begin
writeln('Javascript exception: ',O.toString); writeln('Javascript exception: ',O.toString);
if O is TJSError then if O is TJSError then
Writeln('Error message : ',TJSError(O).Message); Writeln('Error message : ',TJSError(O).Message);
end; end;
Procedure DoRaiseJS; assembler; Procedure TErrorApp.DoRaiseJS; assembler;
asm asm
throw new Object(); throw new Object();
end; end;
Procedure DoRaiseJSError; assembler; Procedure TErrorApp.DoRaiseJSError; assembler;
asm asm
var e = new Error(); var e = new Error();
e.message="My error message"; e.message="My error message";
throw e; throw e;
end; end;
Procedure TErrorApp.Run;
begin begin
// This will only work for the main program if you have set showUncaughtExceptions before rtl.run(); // This will only work for the main program if you have set showUncaughtExceptions before rtl.run();
TJSHtmlButtonElement(Document.getElementById('btnhook')).OnClick:=@DoHook; // TJSHtmlButtonElement(Document.getElementById('btnhook')).OnClick:=@DoHook;
// These will not be caught (yet) // These will not be caught (yet)
TJSHtmlButtonElement(Document.getElementById('btn')).OnClick:=@DoRaise; TJSHtmlButtonElement(Document.getElementById('btn')).OnClick:=@DoRaise;
// Uncomment this to set default exception handlers // Uncomment this to set default exception handlers
@ -63,4 +80,9 @@ begin
// DoRaiseJSError; // DoRaiseJSError;
DoRaise(Nil); DoRaise(Nil);
end;
begin
With TErrorApp.Create do
Run;
end. end.

48
packages/rtl/web.pas
View File

@ -55,8 +55,8 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
*) *)
TEventListenerEvent = TJSEvent; TEventListenerEvent = TJSEvent;
TJSEventHandler = reference to function(Event: TEventListenerEvent): boolean; TJSEventHandler = reference to function(Event: TEventListenerEvent): boolean; safecall;
TJSRawEventHandler = reference to Procedure(Event: TJSEvent); TJSRawEventHandler = reference to Procedure(Event: TJSEvent); safecall;
TJSEventTarget = class external name 'EventTarget' (TJSObject) TJSEventTarget = class external name 'EventTarget' (TJSObject)
public public
@ -636,7 +636,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
{ TJSDataTransferItem } { TJSDataTransferItem }
TJSDataTransferItemCallBack = reference to Procedure(aData : String); TJSDataTransferItemCallBack = reference to Procedure(aData : String); safecall;
TJSDataTransferItem = class external name 'DataTransferItem' (TJSObject) TJSDataTransferItem = class external name 'DataTransferItem' (TJSObject)
private private
@ -712,8 +712,8 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
Property metaKey : Boolean Read FmetaKey; Property metaKey : Boolean Read FmetaKey;
property dataTransfer : TJSDataTransfer Read FDataTransfer; property dataTransfer : TJSDataTransfer Read FDataTransfer;
end; end;
TJSDragDropEventHandler = reference to function(aEvent: TJSDragEvent) : Boolean; TJSDragDropEventHandler = reference to function(aEvent: TJSDragEvent) : Boolean; safecall;
THTMLClickEventHandler = reference to function(aEvent : TJSMouseEvent) : boolean; THTMLClickEventHandler = reference to function(aEvent : TJSMouseEvent) : boolean; safecall;
{ Various events } { Various events }
{$IFNDEF FIREFOX} {$IFNDEF FIREFOX}
@ -791,21 +791,21 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
property Total : NativeUINT Read FTotal; property Total : NativeUINT Read FTotal;
end; end;
TJSPageTransitionEventHandler = reference to function(aEvent : TJsPageTransitionEvent) : boolean; TJSPageTransitionEventHandler = reference to function(aEvent : TJsPageTransitionEvent) : boolean; safecall;
TJSHashChangeEventhandler = reference to function(aEvent : TJSHashChangeEvent) : boolean; TJSHashChangeEventhandler = reference to function(aEvent : TJSHashChangeEvent) : boolean; safecall;
TJSMouseWheelEventHandler = reference to function(aEvent : TJSWheelEvent) : boolean; TJSMouseWheelEventHandler = reference to function(aEvent : TJSWheelEvent) : boolean; safecall;
TJSMouseEventHandler = reference to function(aEvent : TJSMouseEvent) : boolean; TJSMouseEventHandler = reference to function(aEvent : TJSMouseEvent) : boolean; safecall;
THTMLAnimationEventHandler = reference to function(aEvent : TJSAnimationEvent) : boolean; THTMLAnimationEventHandler = reference to function(aEvent : TJSAnimationEvent) : boolean; safecall;
TJSErrorEventHandler = reference to function(aEvent : TJSErrorEvent) : boolean; TJSErrorEventHandler = reference to function(aEvent : TJSErrorEvent) : boolean; safecall;
TJSFocusEventHandler = reference to function(aEvent : TJSFocusEvent) : boolean; TJSFocusEventHandler = reference to function(aEvent : TJSFocusEvent) : boolean; safecall;
TJSKeyEventhandler = reference to function (aEvent : TJSKeyBoardEvent) : boolean; TJSKeyEventhandler = reference to function (aEvent : TJSKeyBoardEvent) : boolean; safecall;
TJSLoadEventhandler = reference to function (aEvent : TJSLoadEvent) : boolean; TJSLoadEventhandler = reference to function (aEvent : TJSLoadEvent) : boolean; safecall;
TJSPointerEventHandler = reference to function(aEvent : TJSPointerEvent) : boolean; TJSPointerEventHandler = reference to function(aEvent : TJSPointerEvent) : boolean; safecall;
TJSUIEventHandler = reference to function(aEvent : TJSUIEvent) : Boolean; TJSUIEventHandler = reference to function(aEvent : TJSUIEvent) : Boolean; safecall;
TJSPopStateEventHandler = reference to function(aEvent : TJSPopStateEvent) : Boolean; TJSPopStateEventHandler = reference to function(aEvent : TJSPopStateEvent) : Boolean; safecall;
TJSStorageEventHandler = reference to function(aEvent : TJSStorageEvent) : Boolean; TJSStorageEventHandler = reference to function(aEvent : TJSStorageEvent) : Boolean; safecall;
TJSProgressEventhandler = reference to function(aEvent : TJSProgressEvent) : Boolean; TJSProgressEventhandler = reference to function(aEvent : TJSProgressEvent) : Boolean; safecall;
TJSTouchEventHandler = reference to function(aEvent : TJSTouchEvent) : boolean; TJSTouchEventHandler = reference to function(aEvent : TJSTouchEvent) : boolean; safecall;
TJSDocument = class external name 'Document' (TJSNode) TJSDocument = class external name 'Document' (TJSNode)
Private Private
@ -1850,7 +1850,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
TJSCSSStyleDeclaration = class; // forward TJSCSSStyleDeclaration = class; // forward
TJSTimerCallBack = reference to procedure; TJSTimerCallBack = reference to procedure; safecall;
Theader = Array [0..1] of String; Theader = Array [0..1] of String;
THeaderArray = Array of Theader; THeaderArray = Array of Theader;
@ -2836,7 +2836,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
TJSCanvasRenderingContext2D = Class; TJSCanvasRenderingContext2D = Class;
THTMLCanvasToBlobCallback = Reference to function (aBlob : TJSBlob) : boolean; THTMLCanvasToBlobCallback = Reference to function (aBlob : TJSBlob) : boolean; safecall;
TJSHTMLCanvasElement = Class external name 'HTMLCanvasElement' (TJSHTMLElement) TJSHTMLCanvasElement = Class external name 'HTMLCanvasElement' (TJSHTMLElement)
Public Public
@ -3106,7 +3106,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
end; end;
{ TJSXMLHttpRequest } { TJSXMLHttpRequest }
TJSOnReadyStateChangeHandler = reference to procedure; TJSOnReadyStateChangeHandler = reference to procedure; safecall;
TJSXMLHttpRequest = class external name 'XMLHttpRequest' (TJSXMLHttpRequestEventTarget) TJSXMLHttpRequest = class external name 'XMLHttpRequest' (TJSXMLHttpRequestEventTarget)
private private
@ -3455,7 +3455,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
end; end;
TJSMutationRecordArray = array of TJSMutationRecord; TJSMutationRecordArray = array of TJSMutationRecord;
TJSMutationCallback = reference to procedure(mutations: TJSMutationRecordArray; observer: TJSMutationObserver); TJSMutationCallback = reference to procedure(mutations: TJSMutationRecordArray; observer: TJSMutationObserver); safecall;
TJSMutationObserverInit = record TJSMutationObserverInit = record
attributes: boolean; attributes: boolean;