411 lines
13 KiB
ObjectPascal
411 lines
13 KiB
ObjectPascal
/// SyNodeSimpleProto - create a JS prototypes with Delphi method/props realisation
|
|
// - this unit is a part of the freeware Synopse framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit SyNodeSimpleProto;
|
|
{
|
|
This file is part of Synopse framework.
|
|
|
|
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - http://synopse.info
|
|
|
|
SyNode for mORMot Copyright (C) 2022 Pavel Mashlyakovsky & Vadim Orel
|
|
pavel.mash at gmail.com
|
|
|
|
Some ideas taken from
|
|
http://code.google.com/p/delphi-javascript
|
|
http://delphi.mozdev.org/javascript_bridge/
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Initial Developer of the Original Code is
|
|
Pavel Mashlyakovsky.
|
|
Portions created by the Initial Developer are Copyright (C) 2014
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
- Arnaud Bouchez
|
|
- Vadim Orel
|
|
- Pavel Mashlyakovsky
|
|
- win2014
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
|
|
Version 1.18
|
|
- initial release. Use SpiderMonkey 45
|
|
|
|
}
|
|
|
|
{$I Synopse.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SpiderMonkey,
|
|
SyNodeProto,
|
|
mORMot { PClassProp };
|
|
|
|
type
|
|
/// A prototype class for wrapping a Delphi class based on a "old" RTTI
|
|
// - create a properties in JavaScript based on the published properties of original class
|
|
// - all published methods of a original calss MUST have a TSMFastNativeCall signature
|
|
TSMSimpleRTTIProtoObject = class(TSMCustomProtoObject)
|
|
protected
|
|
procedure InitObject(aParent: PJSRootedObject); override;
|
|
/// Can be used to optimize JS engine proerty access.
|
|
// - if isReadonly setted to true property become read-only for JS engine
|
|
// - if property valu don't changed during object lifecircle set isDeterministic=true
|
|
// to prevent creating of JS value every time JS engine read property value
|
|
// If method return false propery will not be created in the JS
|
|
function GetPropertyAddInformation(cx: PJSContext; PI:PPropInfo; out isReadonly: boolean;
|
|
out isDeterministic: boolean; aParent: PJSRootedObject): boolean; virtual;
|
|
function GetJSvalFromProp(cx: PJSContext; PI:PPropInfo; instance: PSMInstanceRecord): jsval; virtual;
|
|
public
|
|
|
|
end;
|
|
|
|
function CreateJSInstanceObjForSimpleRTTI(cx: PJSContext; AInstance: TObject; aParent: PJSRootedObject=nil): jsval;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$ifdef ISDELPHIXE2}System.SysUtils,{$else}SysUtils,{$endif}
|
|
SyNode,
|
|
SynCommons;
|
|
|
|
function JSRTTINativeMethodCall(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
|
|
var
|
|
fCallFn: TSMFastNativeCall;
|
|
fCallMethod: TMethod;
|
|
|
|
lfunc: PJSFunction;
|
|
jsobj: PJSObject;
|
|
|
|
Inst: PSMInstanceRecord;
|
|
mc: PSMMethodRec;
|
|
proto: PJSObject;
|
|
begin
|
|
try
|
|
// JS_ConvertValue(cx,JS_CALLEE(cx, vp),JSTYPE_FUNCTION, lfuncVal);
|
|
lfunc := vp.calleObject;
|
|
Assert(Assigned(lfunc));
|
|
|
|
jsobj := vp.thisObject[cx];
|
|
if not IsInstanceObject(cx, jsobj, Inst) then
|
|
raise ESMException.Create(SM_NOT_A_NATIVE_OBJECT);
|
|
jsobj.GetPrototype(cx, proto);
|
|
mc := TSMSimpleRTTIProtoObject(Inst^.proto).getMethod(lfunc, proto);
|
|
|
|
if mc = nil then
|
|
raise ESMException.CreateUTF8('The class has no method "%"', [lfunc.GetFunctionId().ToSynUnicode(cx)]);
|
|
|
|
fCallMethod.Code := mc^.method;
|
|
fCallMethod.Data := Pointer(Inst.instance);
|
|
fCallFn := TSMFastNativeCall(fCallMethod);
|
|
Result := fCallFn(cx, argc, vp);
|
|
except
|
|
on E: Exception do begin
|
|
Result := False;
|
|
vp.rval := JSVAL_VOID;
|
|
JSError(cx, E);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetPropCacheForWrite(cx: PJSContext; obj: PJSObject; id: jsid; var aObj: PSMInstanceRecord): PSMRTTIPropCache;
|
|
var
|
|
i: Integer;
|
|
propName: AnsiString;
|
|
found: boolean;
|
|
begin
|
|
Result := nil;
|
|
if not IsInstanceObject(cx, obj, aObj) then
|
|
raise ESMException.Create(SM_NOT_A_NATIVE_OBJECT);
|
|
propName := PJSString(id).ToAnsi(cx);
|
|
found := False;
|
|
for I := 0 to Length((AObj.proto as TSMSimpleRTTIProtoObject).FRTTIPropsCache)-1 do begin
|
|
Result := @(AObj.proto as TSMSimpleRTTIProtoObject).FRTTIPropsCache[i];
|
|
{$IFDEF SM52}
|
|
if strComparePropGetterSetter(propName, Result.jsName, false) then begin
|
|
{$ELSE}
|
|
if Result.jsName = propName then begin
|
|
{$ENDIF}
|
|
found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not found then
|
|
raise ESMException.CreateFmt('% not found', [propName]);
|
|
|
|
if Result.isReadOnly then
|
|
raise ESMException.CreateUtf8('Property %.% is ReadOnly', [aObj.proto.jsObjName, Result.jsName]);
|
|
end;
|
|
|
|
function JSRTTIPropWrite(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
|
|
var
|
|
Instance: PSMInstanceRecord;
|
|
PI: PPropInfo;
|
|
id: jsid;
|
|
val: jsval;
|
|
begin
|
|
id := jsid(vp.calleObject.FunctionId);
|
|
PI := GetPropCacheForWrite(cx, vp.thisObject[cx], id, Instance).mbr;
|
|
val := vp.argv[0];
|
|
case PI.PropType^{$IFNDEF FPC}^{$ENDIF}.Kind of
|
|
tkInteger, tkEnumeration, tkSet{$ifdef FPC},tkBool{$endif}:
|
|
PI.SetOrdProp(Instance^.instance,val.asInteger);
|
|
tkInt64:
|
|
PI.SetInt64Prop(Instance^.instance, val.asInt64);
|
|
tkFloat:
|
|
PI.SetFloatProp(Instance^.instance, val.asDouble);
|
|
tkLString{$IFDEF FPC},tkLStringOld{$ENDIF},tkWString{$ifdef HASVARUSTRING},tkUString{$endif}:
|
|
PI.SetLongStrValue(Instance^.instance, val.asJsString.ToUTF8(cx));
|
|
else
|
|
raise ESMException.Create('NotImplemented');
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function JSRTTIPropRead(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
|
|
var
|
|
Instance: PSMInstanceRecord;
|
|
proto: TSMCustomProtoObject;
|
|
|
|
propCache: PSMRTTIPropCache;
|
|
PI: PPropInfo;
|
|
|
|
rval: jsval;
|
|
|
|
this: PJSObject;
|
|
storedVal: jsval;
|
|
i: Integer;
|
|
id: PJSString;
|
|
prop_name: AnsiString;
|
|
found: Boolean;
|
|
begin
|
|
try
|
|
this := vp.thisObject[cx];
|
|
|
|
if IsProtoObject(cx, this, proto) then begin
|
|
vp.rval := JSVAL_NULL;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
|
|
if not IsInstanceObject(cx, this, Instance) then
|
|
raise ESMException.Create(SM_NOT_A_NATIVE_OBJECT);
|
|
|
|
id := vp.calleObject.FunctionId;
|
|
prop_name := ID.ToAnsi(cx);
|
|
|
|
propCache := nil;
|
|
found := false;
|
|
for i := 0 to Length((Instance.proto as TSMSimpleRTTIProtoObject).FRTTIPropsCache)-1 do begin
|
|
propCache := @(Instance.proto as TSMSimpleRTTIProtoObject).FRTTIPropsCache[i];
|
|
{$IFDEF SM52}
|
|
if strComparePropGetterSetter(prop_name, propCache.jsName, true) then begin
|
|
{$ELSE}
|
|
if propCache.jsName = prop_name then begin
|
|
{$ENDIF}
|
|
found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not found then
|
|
raise ESMException.CreateFmt('% not found', [prop_name]);
|
|
|
|
if (propCache.DeterministicIndex>=0) then
|
|
storedVal := this.ReservedSlot[propCache.DeterministicIndex]
|
|
else
|
|
storedVal.setVoid;
|
|
|
|
if (not storedVal.isVoid) then
|
|
rval := storedVal
|
|
else begin
|
|
PI := propCache.mbr;
|
|
rval := (Instance.proto as TSMSimpleRTTIProtoObject).GetJSvalFromProp(cx, PI, Instance);
|
|
if (propCache.DeterministicIndex>=0) then begin
|
|
// all jsvals in reserved slots are rooted automatically
|
|
this.ReservedSlot[propCache.DeterministicIndex] := rval;
|
|
end;
|
|
end;
|
|
|
|
vp.rval := rval;
|
|
Result := True;
|
|
except
|
|
on E: Exception do begin
|
|
Result := False;
|
|
JSError(cx, E);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TSMSimpleRTTIProtoObject }
|
|
|
|
function TSMSimpleRTTIProtoObject.GetJSvalFromProp(cx: PJSContext;
|
|
PI: PPropInfo; instance: PSMInstanceRecord): jsval;
|
|
var
|
|
FInst: PSMInstanceRecord;
|
|
tmp: RawUTF8;
|
|
obj: TObject;
|
|
arr: TDynArray;
|
|
begin
|
|
case PI.PropType^.Kind of
|
|
tkInteger, tkEnumeration, tkSet{$ifdef FPC},tkBool{$endif}:
|
|
Result.asInteger := PI.GetOrdValue(Instance^.instance);
|
|
tkInt64:
|
|
Result.asInt64 := PI.GetInt64Value(Instance^.instance);
|
|
tkFloat:
|
|
Result.asDouble := PI.GetDoubleValue(Instance^.instance);
|
|
tkLString,{$ifdef FPC}tkLStringOld,{$endif}tkWString{$ifdef HASVARUSTRING},tkUString{$endif}: begin
|
|
PI.GetLongStrValue(Instance^.instance, tmp);
|
|
Result.asJSString := cx.NewJSString(tmp);
|
|
end;
|
|
tkClass: begin
|
|
new(FInst);
|
|
obj := PI.GetObjProp(Instance^.instance);
|
|
if obj <> nil then
|
|
Result := FInst.CreateForObj(cx, obj, TSMSimpleRTTIProtoObject, Instance.Proto)
|
|
else
|
|
Result := JSVAL_NULL;
|
|
end;
|
|
tkDynArray: begin
|
|
// MPV. WARNING. Every access to dyn array property will create a JS Array, so
|
|
// I recommend avoiding use of the dynamic arrays, or use a temp variable
|
|
arr := PI.GetDynArray(Instance^.instance);
|
|
Result.asJson[cx] := arr.SaveToJSON(true);
|
|
end;
|
|
else
|
|
raise ESMException.Create('NotImplemented');
|
|
end;
|
|
end;
|
|
|
|
procedure TSMSimpleRTTIProtoObject.InitObject(aParent: PJSRootedObject);
|
|
var
|
|
PI: PPropInfo;
|
|
i: integer;
|
|
idx: Integer;
|
|
|
|
CT: TClass;
|
|
n: integer;
|
|
added: boolean;
|
|
isReadonly: boolean;
|
|
isDeterministic: boolean;
|
|
exclude: boolean;
|
|
methods: TPublishedMethodInfoDynArray;
|
|
begin
|
|
for i := 0 to GetPublishedMethods(nil, methods, fRttiCls) - 1 do begin
|
|
idx := FMethodsDA.FindHashedForAdding(methods[i].Name, added);
|
|
if added then with FMethods[idx] do begin
|
|
ujsName := UTF8ToSynUnicode(methods[i].Name);
|
|
method := methods[i].Method.Code;
|
|
nargs := 0;
|
|
isNativeCall := true;
|
|
call := @JSRTTINativeMethodCall;
|
|
flags := [jspEnumerate];
|
|
end;
|
|
end;
|
|
|
|
fDeterministicCnt := 0;
|
|
CT := fRttiCls;
|
|
repeat
|
|
for i := 1 to InternalClassPropInfo(CT,PI) do begin
|
|
idx := Length(FJSProps);
|
|
|
|
exclude := PI^.PropType^.Kind = tkMethod;
|
|
if not exclude then
|
|
for n := 0 to idx - 1 do begin
|
|
if StrLIComp(PAnsiChar(@PI.Name[1]), PAnsiChar(FRTTIPropsCache[n].jsName), length(PI.Name)) = 0 then begin
|
|
exclude := true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if exclude or not GetPropertyAddInformation(fCx, PI, isReadonly, isDeterministic, aParent) then begin
|
|
PI := PI^.Next;
|
|
Continue;
|
|
end;
|
|
|
|
case PI^.PropType^{$IFNDEF FPC}^{$ENDIF}.Kind of
|
|
tkChar, {$IFDEF FPC}tkLString{$ELSE}tkString{$ENDIF}, tkWChar, tkWString, tkVariant:
|
|
begin
|
|
raise ESMException.CreateUtf8('Unsupported class property %.%', [FjsObjName, PI^.Name]);
|
|
end;
|
|
// lazy create class type property prototypes on first read (in TSMSimpleRTTIProtoObject.GetJSvalFromProp)
|
|
// tkClass:
|
|
// defineClass(Cx, PI^.PropType^{$IFNDEF FPC}^{$ENDIF}.ClassType^.ClassType, TSMSimpleRTTIProtoObject, aParent);
|
|
tkEnumeration:
|
|
defineEnum(fCx, PI^.PropType{$IFNDEF FPC_OLDRTTI}^{$ENDIF}, aParent);
|
|
end;
|
|
|
|
SetLength(FJSProps, idx + 1);
|
|
SetLength(FRTTIPropsCache, idx + 1);
|
|
FRTTIPropsCache[idx].jsName := camelize(PI.Name);
|
|
FRTTIPropsCache[idx].mbr := PI;
|
|
FRTTIPropsCache[idx].typeInfo := PI^.PropType{$IFNDEF FPC}^{$ENDIF};
|
|
FRTTIPropsCache[idx].isReadOnly := isReadonly or isDeterministic;
|
|
if isDeterministic then begin
|
|
FRTTIPropsCache[idx].DeterministicIndex := fDeterministicCnt;
|
|
Inc(fDeterministicCnt);
|
|
end else
|
|
FRTTIPropsCache[idx].DeterministicIndex := -1;
|
|
|
|
FJSProps[idx].flags := JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_SHARED;
|
|
FJSProps[idx].Name := PCChar(RTTIPropsCache[idx].jsName);
|
|
// FJSProps[idx].tinyid := idx;
|
|
FJSProps[idx].setter.native.info := nil;
|
|
FJSProps[idx].setter.native.op := JSRTTIPropWrite;
|
|
FJSProps[idx].getter.native.info := nil;
|
|
FJSProps[idx].getter.native.op := JSRTTIPropRead;
|
|
PI := PI^.Next;
|
|
end;
|
|
CT := CT.ClassParent;
|
|
until CT=nil;
|
|
inherited; //MPV !! do not use FMethodsDA.Add()
|
|
end;
|
|
|
|
function TSMSimpleRTTIProtoObject.GetPropertyAddInformation(cx: PJSContext;
|
|
PI: PPropInfo; out isReadonly: boolean; out isDeterministic: boolean; aParent: PJSRootedObject): boolean;
|
|
begin
|
|
isReadonly := false;
|
|
isDeterministic := false;
|
|
result := true;
|
|
end;
|
|
|
|
function CreateJSInstanceObjForSimpleRTTI(cx: PJSContext; AInstance: TObject; aParent: PJSRootedObject=nil): jsval;
|
|
var
|
|
Inst: PSMInstanceRecord;
|
|
eng: TSMEngine;
|
|
begin
|
|
new(Inst);
|
|
if (aParent = nil) then begin
|
|
eng := cx.PrivateData;
|
|
Result := Inst.CreateForObj(cx, AInstance, TSMSimpleRTTIProtoObject, eng.GlobalObject);
|
|
end else
|
|
Result := Inst.CreateForObj(cx, AInstance, TSMSimpleRTTIProtoObject, aParent);
|
|
end;
|
|
|
|
end.
|