Browse Source

* Some fixes and improvements: refresh tree

Michael Van Canneyt 1 year ago
parent
commit
01a49fbe68

+ 26 - 3
packages/wasm-oi/src/debug.objectinspector.html.pas

@@ -61,12 +61,15 @@ type
   private
   private
     FBuilder: THTMLTreeBuilder;
     FBuilder: THTMLTreeBuilder;
     FCaption: String;
     FCaption: String;
+    FOnRefresh: TNotifyEvent;
     FOptions: TOTOptions;
     FOptions: TOTOptions;
     FParentElement,
     FParentElement,
     FCaptionElement : TJSHTMLElement;
     FCaptionElement : TJSHTMLElement;
+    FRootObjectID: Integer;
     function GetOnObjectSelected: TObjectSelectedEvent;
     function GetOnObjectSelected: TObjectSelectedEvent;
     function GetParentElement: TJSHTMLElement;
     function GetParentElement: TJSHTMLElement;
     function GetParentElementID: String;
     function GetParentElementID: String;
+    procedure HandleRefresh(aEvent: TJSEvent);
     procedure SetCaption(AValue: String);
     procedure SetCaption(AValue: String);
     procedure SetOnObjectSelected(AValue: TObjectSelectedEvent);
     procedure SetOnObjectSelected(AValue: TObjectSelectedEvent);
     procedure SetOptions(AValue: TOTOptions);
     procedure SetOptions(AValue: TOTOptions);
@@ -87,6 +90,8 @@ type
     Property OnObjectSelected : TObjectSelectedEvent Read GetOnObjectSelected Write SetOnObjectSelected;
     Property OnObjectSelected : TObjectSelectedEvent Read GetOnObjectSelected Write SetOnObjectSelected;
     Property Caption : String Read FCaption Write SetCaption;
     Property Caption : String Read FCaption Write SetCaption;
     Property Options : TOTOptions Read FOptions Write SetOptions;
     Property Options : TOTOptions Read FOptions Write SetOptions;
+    Property OnRefresh : TNotifyEvent Read FOnRefresh Write FOnRefresh;
+    Property RootObjectID : Integer Read FRootObjectID;
   end;
   end;
 
 
   TPropDataFlag = (pdfNoValue,pdfError);
   TPropDataFlag = (pdfNoValue,pdfError);
@@ -316,6 +321,12 @@ begin
     Result:='';
     Result:='';
 end;
 end;
 
 
+procedure THTMLObjectTree.HandleRefresh(aEvent: TJSEvent);
+begin
+  If Assigned(FOnRefresh) then
+    FOnRefresh(Self);
+end;
+
 procedure THTMLObjectTree.SetCaption(AValue: String);
 procedure THTMLObjectTree.SetCaption(AValue: String);
 begin
 begin
   if FCaption=AValue then Exit;
   if FCaption=AValue then Exit;
@@ -345,17 +356,24 @@ end;
 function THTMLObjectTree.BuildWrapper(aParent : TJSHTMLElement) : TJSHTMLElement;
 function THTMLObjectTree.BuildWrapper(aParent : TJSHTMLElement) : TJSHTMLElement;
 
 
 var
 var
-  DW,DC,DT : TJSHTMLElement;
+  RI,SC,DW,DC,DT : TJSHTMLElement;
 
 
 begin
 begin
   aParent.InnerHTML:='';
   aParent.InnerHTML:='';
   DC:=TJSHTMLElement(document.createElement('div'));
   DC:=TJSHTMLElement(document.createElement('div'));
   DC.className:='ot-caption';
   DC.className:='ot-caption';
+  SC:=TJSHTMLElement(document.createElement('span'));
+  DC.AppendChild(SC);
+  RI:=TJSHTMLElement(document.createElement('div'));
+  RI.className:='ot-icon-btn';
+  RI.InnerHTML:='&#x27F3';
+  RI.AddEventListener('click',@HandleRefresh);
+  DC.AppendChild(RI);
   aParent.AppendChild(DC);
   aParent.AppendChild(DC);
-  FCaptionElement:=DC;
+  FCaptionElement:=SC;
   if Not (otShowCaption in Options) then
   if Not (otShowCaption in Options) then
     DC.classList.Add('ot-hidden');
     DC.classList.Add('ot-hidden');
-  RenderCaption(DC);
+  RenderCaption(SC);
   DT:=TJSHTMLElement(document.createElement('div'));
   DT:=TJSHTMLElement(document.createElement('div'));
   DT.className:='ot-tree';
   DT.className:='ot-tree';
   aParent.AppendChild(DT);
   aParent.AppendChild(DT);
@@ -409,12 +427,16 @@ begin
   if aParentID<>0 then
   if aParentID<>0 then
     lParent:=FBuilder.FindObjectItem(aParentID)
     lParent:=FBuilder.FindObjectItem(aParentID)
   else
   else
+    begin
     lParent:=Nil;
     lParent:=Nil;
+    FRootObjectID:=AID;
+    end;
   FBuilder.AddItem(lParent,aCaption,aID);
   FBuilder.AddItem(lParent,aCaption,aID);
 end;
 end;
 
 
 procedure THTMLObjectTree.Clear;
 procedure THTMLObjectTree.Clear;
 begin
 begin
+  FRootObjectID:=0;
   FBuilder.Clear;
   FBuilder.Clear;
 end;
 end;
 
 
@@ -711,6 +733,7 @@ begin
     DC:=TJSHTMLElement(Document.createElement('div'));
     DC:=TJSHTMLElement(Document.createElement('div'));
     DC.className:='oi-caption';
     DC.className:='oi-caption';
     CS:=TJSHTMLElement(Document.createElement('span'));
     CS:=TJSHTMLElement(Document.createElement('span'));
+    CS.className:='oi-caption-lbl';
     DC.AppendChild(CS);
     DC.AppendChild(CS);
     RenderCaption(CS);
     RenderCaption(CS);
     Result.AppendChild(DC);
     Result.AppendChild(DC);

+ 44 - 15
packages/wasm-oi/src/debug.objectinspector.wasm.pas

@@ -34,15 +34,19 @@ type
   TWasmObjectInspectorApi = class(TImportExtension)
   TWasmObjectInspectorApi = class(TImportExtension)
   private
   private
     FHandleObjectSelection: Boolean;
     FHandleObjectSelection: Boolean;
+    FHandleRefresh: Boolean;
     FInspector: THTMLObjectInspector;
     FInspector: THTMLObjectInspector;
     FLogAPICalls: Boolean;
     FLogAPICalls: Boolean;
     FObjectTree: THTMLObjectTree;
     FObjectTree: THTMLObjectTree;
+    procedure DoRefreshTree(Sender: TObject);
     procedure DoSelectObject(Sender: TObject; aObjectId: Integer);
     procedure DoSelectObject(Sender: TObject; aObjectId: Integer);
     procedure RaiseOILastError(const aOperation: String);
     procedure RaiseOILastError(const aOperation: String);
+    procedure SetHandleHandleRefresh(AValue: Boolean);
     procedure SetHandleObjectSelection(AValue: Boolean);
     procedure SetHandleObjectSelection(AValue: Boolean);
     procedure SetInspector(AValue: THTMLObjectInspector);
     procedure SetInspector(AValue: THTMLObjectInspector);
     procedure SetLogAPICalls(AValue: Boolean);
     procedure SetLogAPICalls(AValue: Boolean);
     procedure SetObjectTree(AValue: THTMLObjectTree);
     procedure SetObjectTree(AValue: THTMLObjectTree);
+    procedure ShowObjectTree(aObjectID: Integer);
   protected
   protected
     procedure Logcall(Const aMsg : string);
     procedure Logcall(Const aMsg : string);
     procedure LogCall(Const aFmt : string; aArgs : Array of const);
     procedure LogCall(Const aFmt : string; aArgs : Array of const);
@@ -58,7 +62,6 @@ type
     function TreeAddObject(aInspectorID: TInspectorID; ObjectData : PObjectData): TWasmOIResult;
     function TreeAddObject(aInspectorID: TInspectorID; ObjectData : PObjectData): TWasmOIResult;
     function TreeClear(aInspectorID: TInspectorID) : TWasmOIResult;
     function TreeClear(aInspectorID: TInspectorID) : TWasmOIResult;
     Procedure HookObjectTree;
     Procedure HookObjectTree;
-    Procedure UnhookObjectTree;
     Function GetTree(aInspectorID : TInspectorID) : THTMLObjectTree;
     Function GetTree(aInspectorID : TInspectorID) : THTMLObjectTree;
     Function GetInspector(aInspectorID : TInspectorID) : THTMLObjectInspector;
     Function GetInspector(aInspectorID : TInspectorID) : THTMLObjectInspector;
   Public
   Public
@@ -69,6 +72,7 @@ type
     Property DefaultObjectTree : THTMLObjectTree Read FObjectTree Write SetObjectTree;
     Property DefaultObjectTree : THTMLObjectTree Read FObjectTree Write SetObjectTree;
     property DefaultInspector : THTMLObjectInspector Read FInspector Write SetInspector;
     property DefaultInspector : THTMLObjectInspector Read FInspector Write SetInspector;
     Property HandleObjectSelection : Boolean Read FHandleObjectSelection Write SetHandleObjectSelection;
     Property HandleObjectSelection : Boolean Read FHandleObjectSelection Write SetHandleObjectSelection;
+    Property HandleTreeRefresh : Boolean Read FHandleRefresh Write SetHandleHandleRefresh;
     property LogAPICalls : Boolean read FLogAPICalls write SetLogAPICalls;
     property LogAPICalls : Boolean read FLogAPICalls write SetLogAPICalls;
   end;
   end;
 
 
@@ -78,6 +82,7 @@ uses rtti;
 
 
 type
 type
   TGetObjectProperties = function(aInspectorID : TInspectorID; aObjectID : TObjectID; aFlags : Longint) : Longint;
   TGetObjectProperties = function(aInspectorID : TInspectorID; aObjectID : TObjectID; aFlags : Longint) : Longint;
+  TGetObjectTree = function(aInspectorID : TInspectorID; aObjectID : TObjectID; aFlags : Longint) : Longint;
 
 
 { TWasmObjectInspectorApi }
 { TWasmObjectInspectorApi }
 
 
@@ -101,8 +106,7 @@ begin
   FObjectTree:=AValue;
   FObjectTree:=AValue;
   if assigned(FObjectTree) then
   if assigned(FObjectTree) then
     FObjectTree.Clear;
     FObjectTree.Clear;
-  if FHandleObjectSelection then
-    HookObjectTree;
+  HookObjectTree;
 end;
 end;
 
 
 procedure TWasmObjectInspectorApi.Logcall(const aMsg: string);
 procedure TWasmObjectInspectorApi.Logcall(const aMsg: string);
@@ -146,19 +150,44 @@ begin
   Raise EWasmOI.Create(S);
   Raise EWasmOI.Create(S);
 end;
 end;
 
 
+procedure TWasmObjectInspectorApi.SetHandleHandleRefresh(AValue: Boolean);
+begin
+  if FHandleRefresh=AValue then Exit;
+  FHandleRefresh:=AValue;
+  HookObjectTree;
+end;
+
 procedure TWasmObjectInspectorApi.DoSelectObject(Sender: TObject; aObjectId: Integer);
 procedure TWasmObjectInspectorApi.DoSelectObject(Sender: TObject; aObjectId: Integer);
 begin
 begin
   GetObjectProperties(aObjectID);
   GetObjectProperties(aObjectID);
 end;
 end;
 
 
+procedure TWasmObjectInspectorApi.DoRefreshTree(Sender: TObject);
+begin
+  IF not Assigned(FObjectTree) then
+    Exit;
+  if (FObjectTree.RootObjectID=0) then
+    Exit;
+  ShowObjectTree(FObjectTree.RootObjectID);
+end;
+
 procedure TWasmObjectInspectorApi.SetHandleObjectSelection(AValue: Boolean);
 procedure TWasmObjectInspectorApi.SetHandleObjectSelection(AValue: Boolean);
 begin
 begin
   if FHandleObjectSelection=AValue then Exit;
   if FHandleObjectSelection=AValue then Exit;
   FHandleObjectSelection:=AValue;
   FHandleObjectSelection:=AValue;
-  if FHandleObjectSelection then
-    HookObjectTree
-  else
-    UnhookObjectTree;
+  HookObjectTree
+end;
+
+procedure TWasmObjectInspectorApi.ShowObjectTree(aObjectID: Integer);
+
+var
+  Proc : TGetObjectTree;
+begin
+  Proc:=TGetObjectTree(InstanceExports['wasm_oi_get_object_tree']);
+  if Not Assigned(Proc) then
+    Raise EWasmOI.Create('No wasm_oi_get_object_tree entry point');
+  if not Proc(0,aObjectID,0)=WASMOI_SUCCESS then
+    RaiseOILastError('GetObjectProperties');
 end;
 end;
 
 
 procedure TWasmObjectInspectorApi.GetObjectProperties(aObjectID: Integer);
 procedure TWasmObjectInspectorApi.GetObjectProperties(aObjectID: Integer);
@@ -272,14 +301,14 @@ procedure TWasmObjectInspectorApi.HookObjectTree;
 begin
 begin
   if not Assigned(FObjectTree) then
   if not Assigned(FObjectTree) then
     Exit;
     Exit;
-  FObjectTree.OnObjectSelected:=@DoSelectObject;
-end;
-
-procedure TWasmObjectInspectorApi.UnhookObjectTree;
-begin
-  if not Assigned(FObjectTree) then
-    Exit;
-  FObjectTree.OnObjectSelected:=Nil;
+  if HandleObjectSelection then
+    FObjectTree.OnObjectSelected:=@DoSelectObject
+  else
+    FObjectTree.OnObjectSelected:=Nil;
+  if HandleTreeRefresh then
+    FObjectTree.OnRefresh:=@DoRefreshTree
+  else
+    FObjectTree.OnRefresh:=Nil;
 end;
 end;
 
 
 function TWasmObjectInspectorApi.InspectorClear(aInspectorID: TInspectorID): TWasmOIResult;
 function TWasmObjectInspectorApi.InspectorClear(aInspectorID: TInspectorID): TWasmOIResult;

+ 1 - 1
packages/wasm-oi/src/wasm.debuginspector.shared.pas

@@ -20,7 +20,7 @@ unit wasm.debuginspector.shared;
 interface
 interface
 
 
 {$IFDEF PAS2JS}
 {$IFDEF PAS2JS}
-uses rtti;
+uses typinfo, rtti;
 {$ENDIF}
 {$ENDIF}
 
 
 Const
 Const