paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-01 20:10:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'main' of https://gitlab.com/freepascal.org/fpc/pas2js into main

Browse Source
This commit is contained in:
mattias 2022-07-12 15:02:54 +02:00
commit 0be56c255f
12 changed files with 216 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
demo/chartjs/demoline.lpr
View File

@ -8,7 +8,7 @@ uses
var
config: TChartConfiguration;
dataset: TChartLineDataset;
dataset, d2: TChartLineDataset;
begin
config := TChartConfiguration.new;
config.type_ := 'line';
@ -21,6 +21,12 @@ begin
dataset.fill := False;
dataset.borderColor := 'rgb(75, 192, 192)';
dataset.lineTension := 0.1;
config.data.datasets := [dataset];
d2 := TChartLineDataset.new;
d2.label_ := 'My other dataset';
d2.data := [35, 49, 90, 70, 55, 45, 20];
d2.fill := False;
d2.borderColor := 'rgb(255, 192, 192)';
d2.lineTension := 0.1;
config.data.datasets := [dataset,d2];
TChart.new('myChart', config);
end.

2
packages/fcl-db/extjsdataset.pas
View File

@ -228,7 +228,7 @@ Var
begin
Result:=True;
if anUpdate.OriginalStatus=usDeleted then
if anUpdate.Status=usDeleted then
exit;
D:=anUpdate.ServerData;
If isNull(D) then

76
packages/fcl-db/jsondataset.pas
View File

@ -185,6 +185,8 @@ type
Procedure AppendToIndex; virtual; abstract;
// Delete aListIndex from list, not from row. Return Recordindex of deleted record.
Function Delete(aListIndex : Integer) : Integer; virtual;
// Delete By rowIndex, Return list index of deleted record.
Function DeleteByRowIndex(aRowIndex : Integer) : Integer; virtual;
// Append aRecordIndex to list. Return ListIndex of appended record.
Function Append(aRecordIndex : Integer) : Integer; virtual; abstract;
// Insert record into list. By default, this does an append. Return ListIndex of inserted record
@ -193,6 +195,8 @@ type
Function Update(aRecordIndex : Integer) : Integer; virtual; abstract;
// Find list index for Record at index aCurrentIndex. Return -1 if not found.
Function FindRecord(aRecordIndex : Integer) : Integer; virtual; abstract;
// index of record in index list, based on Row index.
Function IndexOfRow(aRowIndex : Integer): NativeInt;
// index of record in FRows based on aListIndex in List.
Property RecordIndex[aListIndex : Integer] : NativeInt Read GetRecordIndex;
// Number of records in index. This can differ from FRows, e.g. when filtering.
@ -296,8 +300,6 @@ type
procedure SetRows(AValue: TJSArray);
procedure SetRowType(AValue: TJSONRowType);
protected
Function BlobDataToBytes(aValue : JSValue) : TBytes; override;
Function BytesToBlobData(aValue : TBytes) : JSValue ; override;
// Remove calculated fields from buffer
procedure RemoveCalcFields(Buf: JSValue);
procedure ActivateIndex(Build : Boolean);
@ -395,6 +397,8 @@ type
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
Function BlobDataToBytes(aValue : JSValue) : TBytes; override;
Function BytesToBlobData(aValue : TBytes) : JSValue ; override;
function ConvertDateTimeToNative(aField : TField; aValue : TDateTime) : JSValue; override;
function Locate(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): boolean; override;
function Lookup(const KeyFields: string; const KeyValues: JSValue; const ResultFields: string): JSValue; override;
@ -445,7 +449,7 @@ type
// Fieldmapper to be used when the data is in an object
TJSONObjectFieldMapper = Class(TJSONFieldMapper)
Public
Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
Procedure RemoveField(Const FieldName : String; FieldIndex{%H-} : Integer; Row : JSValue); override;
procedure SetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row,Data : JSValue); override;
Function GetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row : JSValue) : JSValue; override;
Function CreateRow : JSValue; override;
@ -455,7 +459,7 @@ type
// Fieldmapper to be used when the data is in an array
TJSONArrayFieldMapper = Class(TJSONFieldMapper)
Public
Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
Procedure RemoveField(Const FieldName{%H-} : String; FieldIndex : Integer; Row : JSValue); override;
procedure SetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row,Data : JSValue); override;
Function GetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row : JSValue) : JSValue; override;
Function CreateRow : JSValue; override;
@ -585,21 +589,26 @@ end;
procedure TSortedJSONIndex.CreateIndex;
Var
Lst : TJSArray;
Len : Integer;
Lst : Array of Integer;
I,SrcLen,Destlen : Integer;
begin
// CreateIndex is called during constructor. We cannot build index then, so we exit
if FComparer=Nil then
exit;
Len:=FRows.Length-1;
SrcLen:=FRows.Length;
// Temp list, mergsort destroys list
Lst:=TJSArray.New(Len+1);
While Len>=0 do
SetLength(Lst,SrcLen);
DestLen:=0;
For I:=0 to SrcLen-1 do
begin
Lst[Len]:=Len;
Dec(Len);
if not isUndefined(FRows[I]) then
begin
Lst[DestLen]:=I;
Inc(DestLen);
end;
end;
FList:=MergeSort(Lst);
SetLength(Lst,DestLen);
FList:=MergeSort(TJSArray(Lst));
end;
procedure TSortedJSONIndex.AppendToIndex;
@ -994,11 +1003,23 @@ begin
Result:=-1;
end;
function TJSONIndex.DeleteByRowIndex(aRowIndex: Integer): Integer;
begin
Result:=IndexOfRow(aRowIndex);
if Result<>-1 then
FList.Splice(Result,1);
end;
function TJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer): Integer;
begin
Result:=Append(aRecordIndex);
end;
function TJSONIndex.IndexOfRow(aRowIndex: Integer): NativeInt;
begin
Result:=FList.indexOf(aRowIndex);
end;
function TJSONIndex.GetCount: Integer;
begin
Result:=FList.Length;
@ -1164,11 +1185,6 @@ end;
function TBaseJSONDataSet.BlobDataToBytes(aValue: JSValue): TBytes;
Var
S : String;
Arr : TJSUint8Array;
I : Integer;
begin
Result:=[];
Case BlobFormat of
@ -1186,12 +1202,6 @@ end;
function TBaseJSONDataSet.BytesToBlobData(aValue: TBytes): JSValue;
Var
S : String;
Arr : TJSUint8Array;
I : Integer;
Buf : TJSArrayBuffer;
begin
Result:='';
Case BlobFormat of
@ -1476,20 +1486,26 @@ end;
procedure TBaseJSONDataSet.InternalDelete;
Var
Idx : Integer;
I,RowIdx : Integer;
aIndex : TJSONIndex;
begin
Idx:=FCurrentIndex.Delete(FCurrent);
if (Idx<>-1) then
RowIdx:=FCurrentIndex.Delete(FCurrent);
if (RowIdx<>-1) then
begin
// Add code here to Delete from other indexes as well.
For I:=0 to FIndexes.Count-1 do
begin
aIndex:=FIndexes[i].Index;
if aIndex<>FCurrentIndex then
aIndex.DeleteByRowIndex(RowIdx);
end;
// ...
// Add to array of deleted records.
if Not Assigned(FDeletedRows) then
FDeletedRows:=TJSArray.New(FRows[idx])
FDeletedRows:=TJSArray.New(FRows[RowIdx])
else
FDeletedRows.Push(FRows[Idx]);
FRows[Idx]:=Undefined;
FDeletedRows.Push(FRows[RowIdx]);
FRows[RowIdx]:=Undefined;
end;
end;

15
packages/fcl-db/sqldbrestdataset.pp
View File

@ -87,6 +87,7 @@ Type
function GetP(aIndex : Integer): TQueryParam;
procedure SetP(aIndex : Integer; AValue: TQueryParam);
Public
function AddParam(aName : string; aEnabled : Boolean = False) : TQueryParam; overload;
Property Params[aIndex : Integer] : TQueryParam Read GetP Write SetP; default;
end;
@ -193,7 +194,6 @@ end;
function TQueryParam.AsQuery: String;
var
S : String;
B : TBytes;
I : Integer;
@ -221,7 +221,7 @@ begin
else
Result:=AsString
end;
Result:=Name+'='+encodeURIComponent(AsString);
Result:=Name+'='+Result;
end;
{ TQueryParams }
@ -236,6 +236,13 @@ begin
Items[aIndex]:=aValue;
end;
function TQueryParams.AddParam(aName: string; aEnabled: Boolean): TQueryParam;
begin
Result:=add As TQueryParam;
Result.Name:=aName;
Result.Enabled:=aEnabled;
end;
{ TServiceRequest }
constructor TServiceRequest.Create(const aMethod,aURL, aUserName, aPassword: String; aOnDone1 : TNotifyEvent; aOnDone2 : TNotifyEvent = Nil);
@ -582,8 +589,10 @@ begin
if Not jsIsNan(toNumber(D)) then
begin
Result:=Trunc(toNumber(D));
if (Result<=0) then
if (Result<0) then
Raise EJSONDataset.CreateFmt('Invalid maximum length specifier for field %s',[AName])
else if Result=0 then // memofield
Result:=1000000
end
else
begin

2
packages/rtl/Rtl.BrowserLoadHelper.pas
View File

@ -47,7 +47,7 @@ class procedure TBrowserLoadHelper.LoadText(aURL: String; aSync: Boolean; OnLoad
begin
Result:=False;
OnError('Error 999: unknown error');
OnError('Error 999: unknown error: '+TJSJSON.Stringify(response));
end;
begin

5
packages/rtl/classes.pas
View File

@ -10463,10 +10463,9 @@ begin
if not IsAlpha then
ErrorFmt(SParserExpected,[GetTokenName(toSymbol)]);
Result:='';
while IsAlphaNum do
while (not fEofReached) and IsAlphaNum do
begin
Result:=Result+fBuf[fPos];
GotoToNextChar;
end;
end;
@ -10476,7 +10475,7 @@ begin
if fBuf[fPos]=#13 then //CR
GotoToNextChar;
if fBuf[fPos]=#10 then //LF
if (not fEOFReached) and (fBuf[fPos]=#10) then //LF
GotoToNextChar;
inc(fSourceLine);

6
packages/rtl/dateutils.pas
View File

@ -507,7 +507,7 @@ Function ScanDateTime(APattern,AValue: String; APos : integer = 1) : TDateTime;
implementation
uses js, rtlconsts;
uses rtlconsts;
const
TDateTimeEpsilon = 2.2204460493e-16;
@ -2482,7 +2482,7 @@ end;
Const
FmtUTC = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz';
FmtUTCTZ = 'hh":"mm';
// FmtUTCTZ = 'hh":"mm';
function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
@ -2708,12 +2708,14 @@ begin
end;
end;
(*
Function ISOTZStrToTZOffset(TZ : String) : Integer;
begin
if not TryISOTZStrToTZOffSet(TZ,Result) then
Raise EConvertError.CreateFmt('Invalid ISO timezone string',[TZ]);
end;
*)
Function TryISO8601ToDate(const DateString: string; out ADateTime: TDateTime;ReturnUTC : Boolean = True) : Boolean;

17
packages/rtl/web.pas
View File

@ -48,6 +48,8 @@ Type
TJSServiceWorker = weborworker.TJSServiceWorker;
TJSServiceWorkerRegistration = weborworker.TJSServiceWorkerRegistration;
TJSMessageEvent = weborworker.TJSMessageEvent;
TJSMessagePortArray = TJSMessagePortDynArray;
{ TEventListenerEvent }
@ -2944,22 +2946,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
TJSWebSocket
--------------------------------------------------------------------}
TJSMessagePortArray = Array of TJSMessagePort;
{ TJSMessageEvent }
TJSMessageEvent = class external name 'MessageEvent' (TEventListenerEvent)
private
FData: JSValue; external name 'data';
FLastEventID: String; external name 'lastEventID';
FOrigin: String; external name 'origin';
FPorts: TJSMessagePortArray; external name 'ports';
Public
Property Data : JSValue Read FData;
Property LastEventID : String Read FLastEventID;
Property Origin : String Read FOrigin;
Property Ports : TJSMessagePortArray Read FPorts;
end;
TJSWebSocket = class external name 'WebSocket' (TJSEventTarget)
Private

2
packages/rtl/webassembly.pas
View File

@ -14,6 +14,7 @@ Type
TJSWebAssemblyMemoryDescriptor = record
initial,
maximum : integer;
shared : Boolean;
end;
TJSWebAssemblyMemory = class external name 'WebAssembly.Memory' (TJSObject)
@ -23,6 +24,7 @@ Type
Public
constructor new (memorydescriptor : TJSWebAssemblyMemoryDescriptor);
constructor new (memorydescriptor : TJSObject);
Function grow(number : NativeInt) : NativeInt; external name 'grow';
Property buffer : TJSArrayBuffer Read FBuffer;
Property length: NativeInt Read FLength;
end;

15
packages/rtl/weborworker.pas
View File

@ -131,6 +131,21 @@ type
end;
TJSMessagePortDynArray = Array of TJSMessagePort;
{ TJSMessageEvent }
TJSMessageEvent = class external name 'MessageEvent' (TJSEvent)
private
FData: JSValue; external name 'data';
FLastEventID: String; external name 'lastEventID';
FOrigin: String; external name 'origin';
FPorts: TJSMessagePortDynArray; external name 'ports';
Public
Property Data : JSValue Read FData;
Property LastEventID : String Read FLastEventID;
Property Origin : String Read FOrigin;
Property Ports : TJSMessagePortDynArray Read FPorts;
end;
{ TJSExtendableMessageEvent }
TJSExtendableMessageEvent = class external name 'ExtendableMessageEvent' (TJSExtendableEvent)

12
packages/rtl/webworker.pas
View File

@ -70,6 +70,18 @@ Type
Property Self_ : TJSWorkerGlobalScope Read FSelf;
end;
{ TJSDedicatedWorkerGlobalScope }
TJSDedicatedWorkerGlobalScope = class external name 'DedicatedWorkerGlobalScope' (TJSWorkerGlobalScope)
private
FName: String; external name 'name';
Public
Procedure close;
Procedure PostMessage(aMessage : JSValue); overload;
Procedure PostMessage(aMessage : JSValue; TransferableObjects : Array of JSValue); overload;
Property name : String Read FName;
end;
TJSClientsMatchAllOptions = class external name 'Object'
includeUncontrolled : Boolean;
type_ : string; external name 'type';

111
packages/wasi/wasienv.pas
View File

@ -336,6 +336,7 @@ type
Class Var UTF8TextDecoder: TJSTextDecoder;
Protected
class procedure setBigUint64(View: TJSDataView; byteOffset, value: NativeInt; littleEndian: Boolean);
class procedure setBigInt64(View: TJSDataView; byteOffset, value: NativeInt; littleEndian: Boolean);
procedure DoConsoleWrite(IsStdErr: Boolean; aBytes: TJSArray); virtual;
procedure GetImports(aImports: TJSObject); virtual;
Function GetTime(aClockID : NativeInt): NativeInt; virtual;
@ -396,6 +397,14 @@ type
Constructor Create;
Destructor Destroy; override;
Function GetUTF8StringFromMem(aLoc, aLen : Longint) : String;
Procedure SetMemInfoInt8(aLoc : Integer; aValue : ShortInt);
Procedure SetMemInfoInt16(aLoc : Integer; aValue : SmallInt);
Procedure SetMemInfoInt32(aLoc : Integer; aValue : Longint);
Procedure SetMemInfoInt64(aLoc : Integer; aValue : NativeInt);
Procedure SetMemInfoUInt8(aLoc : Integer; aValue : Byte);
Procedure SetMemInfoUInt16(aLoc : Integer; aValue : Word);
Procedure SetMemInfoUInt32(aLoc : Integer; aValue : Cardinal);
Procedure SetMemInfoUInt64(aLoc : Integer; aValue : NativeUint);
// Add imports
Procedure AddImports(aObject: TJSObject);
Property ImportObject : TJSObject Read GetImportObject;
@ -582,6 +591,7 @@ begin
Fenv.OnGetConsoleInputString:=@DoStdRead;
FMemoryDescriptor.initial:=256;
FMemoryDescriptor.maximum:=256;
FMemoryDescriptor.shared:=False;
FTableDescriptor.initial:=0;
FTableDescriptor.maximum:=0;
FTableDescriptor.element:='anyfunc';
@ -782,6 +792,28 @@ begin
end;
end;
class procedure TPas2JSWASIEnvironment.setBigInt64(View: TJSDataView;
byteOffset, value: NativeInt; littleEndian: Boolean);
Var
LowWord,HighWord : Integer;
begin
lowWord:=value;
highWord:=value shr 32;
if LittleEndian then
begin
view.setint32(ByteOffset+0, lowWord, littleEndian);
view.setint32(ByteOffset+4, highWord, littleEndian);
end
else
begin
view.setint32(ByteOffset+4, lowWord, littleEndian);
view.setint32(ByteOffset+0, highWord, littleEndian);
end;
end;
procedure TPas2JSWASIEnvironment.SetInstance(AValue: TJSWebAssemblyInstance);
begin
if Finstance=AValue then Exit;
@ -1371,6 +1403,85 @@ begin
Result:=UTF8TextDecoder.Decode(getModuleMemoryDataView.buffer.slice(aLoc,aLoc+alen));
end;
procedure TPas2JSWASIEnvironment.SetMemInfoInt8(aLoc: Integer; aValue: ShortInt
);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
view.setint8(aLoc,aValue);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoInt16(aLoc: Integer; aValue: SmallInt);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
view.setint16(aLoc,aValue, IsLittleEndian);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoInt32(aLoc: Integer; aValue: Longint);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
view.setInt32(aLoc,aValue,IsLittleEndian);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoInt64(aLoc: Integer; aValue: NativeInt);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
setBigInt64(View,aLoc,aValue,IsLittleEndian);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoUInt8(aLoc: Integer; aValue: Byte);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
view.setUInt8(aLoc,aValue);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoUInt16(aLoc: Integer; aValue: Word);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
view.setUint16(aLoc,aValue,IsLittleEndian);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoUInt32(aLoc: Integer;
aValue: Cardinal);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
view.setUint32(aLoc,aValue,IsLittleEndian);
end;
procedure TPas2JSWASIEnvironment.SetMemInfoUInt64(aLoc: Integer;
aValue: NativeUint);
Var
View : TJSDataView;
begin
view:=getModuleMemoryDataView();
setBigUint64(View,aLoc,aValue,IsLittleEndian);
end;
initialization
end.