* Merging revisions 1139,r1140,r1141,r1142,r1143,r1144,r1145,r1146 from trunk:

    ------------------------------------------------------------------------
    r1139 | mattias | 2021-04-06 12:48:28 +0200 (Tue, 06 Apr 2021) | 1 line
    
    rtl: clean up
    ------------------------------------------------------------------------
    r1140 | michael | 2021-04-08 14:31:29 +0200 (Thu, 08 Apr 2021) | 1 line
    
    * Clipboard support (bug ID 0038726)
    ------------------------------------------------------------------------
    r1141 | michael | 2021-04-13 09:03:02 +0200 (Tue, 13 Apr 2021) | 1 line
    
    * Fix missing override; patch by Henrique Werlang (issue 38747)
    ------------------------------------------------------------------------
    r1142 | michael | 2021-04-13 09:07:07 +0200 (Tue, 13 Apr 2021) | 1 line
    
    * Fix for destroying nested datasets, patch by Henrique Werlang (issue 38749)
    ------------------------------------------------------------------------
    r1143 | michael | 2021-04-13 09:16:07 +0200 (Tue, 13 Apr 2021) | 1 line
    
    * Fix wrong comparison of objects, adjusted patch by Henrique Werlang (Issue 38748)
    ------------------------------------------------------------------------
    r1144 | michael | 2021-04-13 09:23:33 +0200 (Tue, 13 Apr 2021) | 1 line
    
    * Use TBoolStrs for Boolean.ToString helper
    ------------------------------------------------------------------------
    r1145 | michael | 2021-04-13 21:11:06 +0200 (Tue, 13 Apr 2021) | 1 line
    
    * Publish OnRecordResolved, OnLoadFail
    ------------------------------------------------------------------------
    r1146 | michael | 2021-04-13 21:11:36 +0200 (Tue, 13 Apr 2021) | 1 line
    
    * TBlobField.DisplayValue
    ------------------------------------------------------------------------

packages/fcl-db/db.pas

@@ -334,7 +334,7 @@ type
     procedure SetText(const AValue: string); virtual;
     procedure SetVarValue(const AValue{%H-}: JSValue); virtual;
     procedure SetAsBytes(const AValue{%H-}: TBytes); virtual;
-    procedure DefineProperties(Filer: TFiler); 
+    procedure DefineProperties(Filer: TFiler);  override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -663,16 +663,19 @@ type
 
 
 { TBlobField }
+  TBlobDisplayValue = (dvClass, dvFull, dvClip, dvFit);
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
   TBlobType = ftBlob..ftMemo;
 
   TBlobField = class(TBinaryField)
   private
+    FDisplayValue: TBlobDisplayValue;
     FModified : Boolean;
     // Wrapper that retrieves FDataType as a TBlobType
     function GetBlobType: TBlobType;
     // Wrapper that calls SetFieldType
     procedure SetBlobType(AValue: TBlobType);
+    procedure SetDisplayValue(AValue: TBlobDisplayValue);
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
     function GetBlobSize: Longint; virtual;
@@ -687,6 +690,7 @@ type
     property Modified: Boolean read FModified write FModified;
     property Value: string read GetAsString write SetAsString;
   published
+    property DisplayValue: TBlobDisplayValue read FDisplayValue write SetDisplayValue default dvClass;
     property BlobType: TBlobType read GetBlobType write SetBlobType; // default ftBlob;
     property Size default 0;
   end;
@@ -736,6 +740,8 @@ type
     procedure Bind(Binding: Boolean); override;
   public
     constructor Create(AOwner: TComponent); override;
+
+    destructor Destroy; override;
   end;
 
 { TIndexDef }
@@ -2371,6 +2377,9 @@ var
 
 begin
   Active:=False;
+
+  SetDataSetField(nil);
+
   FFieldDefs.Free;
   FFieldList.Free;
   FNestedDataSets.Free;
@@ -4060,7 +4069,7 @@ begin
     begin
     S:='';
     For I:=0 to Length(AValue)-1 do
-      TJSString(S).Concat(IntToHex(aValue[i],2));
+      S:=TJSString(S).Concat(IntToHex(aValue[i],2));
     Result:=S;
     end;
 end;
@@ -7218,7 +7227,14 @@ end;
 
 procedure TBlobField.SetBlobType(AValue: TBlobType);
 begin
+  SetFieldType(aValue);
+end;
 
+procedure TBlobField.SetDisplayValue(AValue: TBlobDisplayValue);
+begin
+  if FDisplayValue=AValue then Exit;
+  FDisplayValue:=AValue;
+  PropertyChanged(False);
 end;
 
 class procedure TBlobField.CheckTypeSize(AValue: Longint);
@@ -7248,8 +7264,26 @@ begin
 end;
 
 procedure TBlobField.GetText(var AText: string; ADisplayText: Boolean);
+
 begin
-  AText := inherited GetAsString;
+  Case FDisplayValue of
+  dvClass:
+    aText:=GetClassDesc;
+  dvFull:
+    aText:=GetAsString;
+  dvClip:
+    begin
+    aText:=GetAsString;
+    if aDisplayText and (Length(aText)>DisplayWidth) then
+      aText:=Copy(Text,1,DisplayWidth) + '...';
+    end;
+  dvFit:
+    begin
+    aText:=GetAsString;
+    if aDisplayText and (Length(aText)>DisplayWidth) then
+      aText:=GetClassDesc;
+    end;
+  end;
 end;
 
 class function TBlobField.IsBlob: Boolean;
@@ -9120,14 +9154,18 @@ begin
     if Assigned(DataSet) then
       DataSet.NestedDataSets.Remove(FNestedDataSet);
   end;
+
   if Assigned(Value) then
-  begin
     DataSet.NestedDataSets.Add(Value);
-    FFields := Value.Fields;
-  end
-  else
-    FFields := nil;
+
   FNestedDataSet := Value;
 end;
 
+destructor TDataSetField.Destroy;
+begin
+  AssignNestedDataSet(nil);
+
+  inherited;
+end;
+
 end.

packages/fcl-db/jsondataset.pas

@@ -415,6 +415,8 @@ type
     property OnFilterRecord;
     property OnNewRecord;
     property OnPostError;
+    Property OnRecordResolved;
+    property OnLoadFail;
   end;
 
   { TJSONObjectFieldMapper }

packages/rtl/classes.pas

@@ -1619,7 +1619,7 @@ var
 
 var
   cc,quoted : char;
-  i,aLen : Integer;
+  aLen : Integer;
 begin
   result := 0;
   c := 1;

packages/rtl/generics.collections.pas

@@ -152,6 +152,7 @@ type
   TList<T> = class(TCustomList<T>)
   private
     FComparer: IComparer<T>;
+    function SameValue(const Left, Right: T): Boolean;
   protected
     procedure SetCapacity(AValue: SizeInt); override;
     procedure SetCount(AValue: SizeInt);
@@ -812,6 +813,14 @@ end;
 
 { TList }
 
+function TList<T>.SameValue(const Left, Right: T): Boolean;
+begin
+  if Assigned(FComparer) then
+    Result:=(FComparer.Compare(Left, Right) = 0)
+  else
+    Result:=(Left = Right);
+end;
+
 procedure TList<T>.SetCapacity(AValue: SizeInt);
 begin
   if AValue < Count then
@@ -877,7 +886,6 @@ end;
 constructor TList<T>.Create;
 begin
   InitializeList;
-  FComparer := TComparer<T>.Default;
 end;
 
 constructor TList<T>.Create(const AComparer: IComparer<T>);
@@ -1111,7 +1119,7 @@ var
   i: SizeInt;
 begin
   for i := 0 to Count - 1 do
-    if FComparer.Compare(AValue, FItems[i]) = 0 then
+    if SameValue(AValue, FItems[i]) then
       Exit(i);
   Result:=-1;
 end;
@@ -1121,7 +1129,7 @@ var
   i: SizeInt;
 begin
   for i := Count - 1 downto 0 do
-    if FComparer.Compare(AValue, FItems[i]) = 0 then
+    if SameValue(AValue, FItems[i]) then
       Exit(i);
   Result:=-1;
 end;

packages/rtl/sysutils.pas

@@ -1067,15 +1067,19 @@ Type
     Function TestBit(const Index:TNativeUIntBitIndex) :Boolean; inline;
   end;
 
+{$SCOPEDENUMS ON}
+  TUseBoolStrs = (False,True);
+{$SCOPEDENUMS OFF}
+
   TBooleanHelper = Type Helper for Boolean
   public
     Class Function Parse(const S: string): Boolean; inline; static;
     Class Function Size: Integer; inline; static;
-    Class Function ToString(const AValue: Boolean; UseBoolStrs: Boolean = false): string; overload; inline; static;
+    Class Function ToString(const AValue: Boolean; UseBoolStrs: TUseBoolStrs = TUseBoolStrs.false): string; overload; inline; static;
     Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static;
   Public
     Function ToInteger: Integer; inline;
-    Function ToString(UseBoolStrs: Boolean = False): string; overload; inline;
+    Function ToString(UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
   end;
 
   TByteBoolHelper = Type Helper for ByteBool
@@ -7964,10 +7968,10 @@ begin
   Result:=1;
 end;
 
-Class Function TBooleanHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline;
+Class Function TBooleanHelper.ToString(const AValue: Boolean; UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
 
 begin
-  Result:=BoolToStr(AValue,UseBoolStrs);
+  Result:=BoolToStr(AValue,UseBoolStrs=TUseBoolStrs.True);
 end;
 
 Class Function TBooleanHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
@@ -7982,10 +7986,10 @@ begin
   Result:=Integer(Self);
 end;
 
-Function TBooleanHelper.ToString(UseBoolStrs: Boolean= False): string; overload; inline;
+Function TBooleanHelper.ToString(UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
 
 begin
-  Result:=BoolToStr(Self,UseBoolStrs);
+  Result:=BoolToStr(Self,UseBoolStrs=TUseBoolStrs.True);
 end;
 
 { ---------------------------------------------------------------------

packages/rtl/web.pas

@@ -41,6 +41,7 @@ Type
   TJSPointerEvent = Class;
   TJSUIEvent = class;
   TJSTouchEvent = Class;
+  TJSBlob = class;
 
 
   { TEventListenerEvent }
@@ -725,6 +726,14 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
   end;
   TJSDragDropEventHandler = reference to function(aEvent: TJSDragEvent) : Boolean; safecall;
   THTMLClickEventHandler = reference to function(aEvent : TJSMouseEvent) : boolean; safecall;
+
+  TJSClipBoardEvent = Class external name 'ClipboardEvent' (TJSEvent)
+  Private
+    FClipboardData: TJSDataTransfer external name 'clipboardData';
+  Public
+    Property ClipBoardData : TJSDataTransfer Read FClipBoardData;
+  end;
+
   { Various events }
 
 {$IFNDEF FIREFOX}
@@ -1766,6 +1775,22 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
     property ready : TJSPromise read FReady;
   end;
 
+  TJSClipboardItemOptions = Class external name 'Object' (TJSObject)
+    presentationStyle : String;
+  end;
+
+  TJSClipBoardItem = Class external name 'ClipboardItem' (TJSObject)
+    constructor new(aData : TJSObject; aOptions : TJSOBject); overload;
+    constructor new(aData : TJSObject; aOptions : TJSClipboardItemOptions); overload;
+    constructor new(aData : TJSObject); overload;
+  end;
+
+  TJSClipBoard = class external name 'Clipboard' (TJSEventTarget)
+    Function read : TJSPromise;
+    Function readText : TJSPromise;
+    Function write(Data : Array of TJSClipBoardItem) : TJSPromise;
+    Function writeText(aText : String) : TJSPromise;
+  end;
 
   { TJSNavigator }
 
@@ -1786,6 +1811,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
     FPlatform: string; external name 'platform';
     FServiceWorker: TJSServiceWorkerContainer; external name 'serviceWorker';
     FUserAgent: string; external name 'userAgent';
+    fClipBoard : TJSClipBoard; external name 'clipboard';
   public
     function getBattery : TJSPromise;
     function requestMediaKeySystemAccess(aKeySystem : String; supportedConfigurations : TJSValueDynArray) : TJSPromise;
@@ -1808,6 +1834,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
     property platform : string read FPlatform;
     property userAgent : string read FUserAgent;
     property serviceWorker : TJSServiceWorkerContainer read FServiceWorker;
+    property ClipBoard : TJSClipBoard Read FCLipboard;
   end;
 
   { TJSTouchEvent }
@@ -1866,7 +1893,6 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
     property width: Integer read Fwidth;
   end;
 
-  TJSBlob = class;
 
   TJSParamEnumCallBack = reference to procedure (const aKey,aValue : string);
   TJSURLSearchParams = class external name 'URLSearchParams' (TJSObject)
@@ -3765,6 +3791,20 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
     content : TJSHTMLElement;
   end;
 
+    TJSHTMLOrXMLDocument = Class external name 'Document' (TJSDocument)
+  end;
+
+  TJSHTMLDocument = Class external name 'HTMLDocument' (TJSHTMLOrXMLDocument)
+  end;
+
+  TJSXMLDocument = Class external name 'HTMLDocument' (TJSHTMLOrXMLDocument)
+  end;
+
+  TDOMParser = Class external name 'DOMParser' (TJSObject)
+  Public
+    Function parseFromString (aString,aMimetype : String): TJSHTMLOrXMLDocument;
+  end;
+
 
 var
   document : TJSDocument; external name 'document';